diff options
Diffstat (limited to 'tcllib/modules/des')
| -rw-r--r-- | tcllib/modules/des/ChangeLog | 145 | ||||
| -rw-r--r-- | tcllib/modules/des/des.bench | 105 | ||||
| -rw-r--r-- | tcllib/modules/des/des.man | 206 | ||||
| -rw-r--r-- | tcllib/modules/des/des.tcl | 272 | ||||
| -rw-r--r-- | tcllib/modules/des/des.test | 408 | ||||
| -rw-r--r-- | tcllib/modules/des/pkgIndex.tcl | 7 | ||||
| -rw-r--r-- | tcllib/modules/des/tcldes.man | 25 | ||||
| -rw-r--r-- | tcllib/modules/des/tcldes.tcl | 1089 | ||||
| -rw-r--r-- | tcllib/modules/des/tcldesjr.man | 25 | ||||
| -rw-r--r-- | tcllib/modules/des/tcldesjr.tcl | 1055 |
10 files changed, 3337 insertions, 0 deletions
diff --git a/tcllib/modules/des/ChangeLog b/tcllib/modules/des/ChangeLog new file mode 100644 index 0000000..fe43322 --- /dev/null +++ b/tcllib/modules/des/ChangeLog @@ -0,0 +1,145 @@ +2013-12-17 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * tcldes.man: New documentation files for the helper packages, + * tcldesjr.man: refering back to the main package. + +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-08-20 Andreas Kupries <andreask@activestate.com> + + * des.man: Bumped version to 1.1 due to API extension made by + * des.tcl: the last change. + * pkgIndex.tcl: + +2007-07-05 Pat Thoyts <patthoyts@users.sourceforge.net> + + * des.test: Previous version of DES used to pad the key to 64 + * des.tcl: bits. If we are using the old options then add padding. The new + version will raise an error instead. + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * des.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * des.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * des.test: Hooked into the new common test support code. + +2005-10-18 Andreas Kupries <andreask@activestate.com> + + * des.bench: Extended with benchmarks for the keyschedule. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-09-26 Andreas Kupries <andreask@activestate.com> + + * des.man: Fixed syntax error introduced by the last commit. + +2005-09-26 Pat Thoyts <patthoyts@users.sourceforge.net> + + * des.tcl: Imported TclDES to provide a more complete + * des.test: implementation of DES and 3DES which supports + * des.man: ECB,CBC,OFB and CFB modes. Tcllib des is now + * tcldes.tcl: a compatability wrapper which continues to + * tcldesjr.tcl: support the previous API and a new one. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-09-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * des.tcl: Fixed expr'essions without braces. + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * des.tcl, des.man, pkgIndex.tcl: Hiked the version to 0.8.1 + * des.tcl (DesBlock): Change the final result from binary format + to some bit-shifting for tcl < 8.4 to fix for 64 bit platforms. + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * des.tcl: Fixed bug #614591. + +2003-02-11 Pat Thoyts <patthoyts@users.sourceforge.net> + + * des.tcl: Imported and tcllib-ised the DES package + from wiki page "DES in Tcl" by Jochen Loewer. NOT added to the + main package list as it requires CBC/CFB/OFB modes for real use. + * des.test: Modified the Trfcrypt DES test suite. + * des.man: Simple documentation - needs more. diff --git a/tcllib/modules/des/des.bench b/tcllib/modules/des/des.bench new file mode 100644 index 0000000..2f769eb --- /dev/null +++ b/tcllib/modules/des/des.bench @@ -0,0 +1,105 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'des' module. +# This allow developers to monitor/gauge/track package performance. +# +# (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net> + +# We need at least version 8.2 for the package and thus the +# benchmarks. + +if {![package vsatisfies [package provide Tcl] 8.2]} { + return +} + +# ### ### ### ######### ######### ######### ########################### +## Setting up the environment ... + +package forget tclDES +catch {namespace delete ::des} +catch {source [file join [file dirname [info script]] tcldes.tcl]} + +package forget des +catch {namespace delete ::DES} +source [file join [file dirname [info script]] des.tcl] + +set i [binary format H* 0000000000000000] +set p [binary format H* 0123456789ABCDEF0123456789ABCDEF]] + +set k [binary format H* FEDCBA9876543210] +set c [binary format H* ED39D950FA74BCC4ED39D950FA74BCC4] + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +bench -desc "DES 1des ECB encryption" -body { + DES::des -mode ecb -dir enc -key $k -iv $i $p +} + +bench -desc "DES 1des ECB decryption" -body { + DES::des -mode ecb -dir dec -key $k -iv $i $c +} + +bench -desc "DES 1des ECB encryption core" -pre { + set key [DES::Init ecb $k $i] +} -body { + DES::Encrypt $key $p +} -post { + DES::Final $key +} + +bench -desc "DES 1des ECB decryption core" -pre { + set key [DES::Init ecb $k $i] +} -body { + DES::Decrypt $key $c +} -post { + DES::Final $key +} + +bench -desc "DES 1des ECB keyschedule" -body { + DES::Final [DES::Init ecb $k $i] +} + +bench -desc "DES 1des CBC keyschedule" -body { + DES::Final [DES::Init cbc $k $i] +} + +if {[llength [package provide tclDES]] != 0} { + set k [binary format H* FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210] + + bench -desc "DES 3des ECB encryption" -body { + DES::des -mode ecb -dir enc -key $k -iv $i $p + } + + bench -desc "DES 3des ECB decryption" -body { + DES::des -mode ecb -dir dec -key $k -iv $i $c + } + + bench -desc "DES 3des ECB encryption core" -pre { + set key [DES::Init ecb $k $i] + } -body { + DES::Encrypt $key $p + } -post { + DES::Final $key + } + + bench -desc "DES 3des ECB decryption core" -pre { + set key [DES::Init ecb $k $i] + } -body { + DES::Decrypt $key $c + } -post { + DES::Final $key + } + + bench -desc "DES 3des ECB keyschedule" -body { + DES::Final [DES::Init ecb $k $i] + } + + bench -desc "DES 3des CBC keyschedule" -body { + DES::Final [DES::Init cbc $k $i] + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/des/des.man b/tcllib/modules/des/des.man new file mode 100644 index 0000000..60b4c19 --- /dev/null +++ b/tcllib/modules/des/des.man @@ -0,0 +1,206 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin des n 1.1] +[see_also aes(n)] +[see_also blowfish(n)] +[see_also md5(n)] +[see_also rc4(n)] +[see_also sha1(n)] +[keywords 3DES] +[keywords {block cipher}] +[keywords {data integrity}] +[keywords DES] +[keywords encryption] +[keywords security] +[copyright {2005, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[moddesc {Data Encryption Standard (DES)}] +[titledesc {Implementation of the DES and triple-DES ciphers}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require des 1.1] +[description] +[para] + +This is an implementation in Tcl of the Data Encryption Standard (DES) +as published by the U.S. National Institute of Standards and +Technology (NIST) [lb]1[rb]. This implementation also supports triple +DES (3DES) extension to DES. DES is a 64-bit block cipher that uses a +56-bit key. 3DES uses a 168-bit key. DES has now officially been +superceeded by AES but is in common use in many protocols. + +[para] + +The tcllib implementation of DES and 3DES uses an implementation by +Mac Cody and is available as a separate download from [lb]2[rb]. For +anyone concerned about the details of exporting this code please see +the TclDES web pages. The tcllib specific code is a wrapper to the +TclDES API that presents same API for the DES cipher as for other +ciphers in the library. + +[section "COMMANDS"] + +[list_begin definitions] +[call [cmd "::DES::des"] \ + [opt [arg "-mode [lb]ecb|cbc|cfb|ofb[rb]"]] \ + [opt [arg "-dir [lb]encrypt|decrypt[rb]"]] \ + [arg "-key keydata"] \ + [opt [arg "-iv vector"]] \ + [opt [arg "-hex"]] \ + [opt [arg "-weak"]] \ + [opt [arg "-out channel"]] \ + [opt [arg "-chunksize size"]] \ + [lb] [arg "-in channel"] | \ + [arg "data"] [rb]] + +Perform the [package DES] algorithm on either the data provided +by the argument or on the data read from the [arg "-in"] channel. If +an [arg "-out"] channel is given then the result will be written to +this channel. + +[para] + +The [arg -key] option must be given. This parameter takes a binary +string of 8 bytes in length and is used to generate the key schedule. +In DES only 56 bits of key data are used. The highest bit from each +byte is discarded. + +[para] + +The [arg -mode] and [arg -dir] options are optional and default to cbc +mode and encrypt respectively. The initialization vector [arg -iv] +takes an 8 byte binary argument. This defaults to all zeros. See +[sectref "MODES OF OPERATION"] for more about [arg -mode] and the use +of the initialization vector. + +[para] + +DES is a 64-bit block cipher. This means that the data must be +provided in units that are a multiple of 8 bytes. + +[list_end] + +[section "PROGRAMMING INTERFACE"] + +Internal state is maintained in an opaque structure that is returned +from the [cmd Init] function. In ECB mode the state is not affected by +the input but for other modes some input dependent state is maintained +and may be reset by calling the [cmd Reset] function with a new +initialization vector value. + +[list_begin definitions] + +[call [cmd "::DES::Init"] [arg "mode"] [arg "keydata"] [arg "iv"] [opt [arg "weak"]]] + +Construct a new DES key schedule using the specified key data and the +given initialization vector. The initialization vector is not used +with ECB mode but is important for other usage modes. +See [sectref "MODES OF OPERATION"]. + +[para] + +There are a small number of keys that are known to be weak when used +with DES. By default if such a key is passed in then an error will be +raised. If there is a need to accept such keys then the [arg weak] +parameter can be set true to avoid the error being thrown. + +[call [cmd "::DES::Encrypt"] [arg "Key"] [arg "data"]] + +Use a prepared key acquired by calling [cmd Init] to encrypt the +provided data. The data argument should be a binary array that is a +multiple of the DES block size of 8 bytes. The result is a binary +array the same size as the input of encrypted data. + +[call [cmd "::DES::Decrypt"] [arg "Key"] [arg "data"]] + +Decipher data using the key. Note that the same key may be used to +encrypt and decrypt data provided that the initialization vector is +reset appropriately for CBC mode. + +[call [cmd "::DES::Reset"] [arg "Key"] [arg "iv"]] + +Reset the initialization vector. This permits the programmer to re-use +a key and avoid the cost of re-generating the key schedule where the +same key data is being used multiple times. + +[call [cmd "::DES::Final"] [arg "Key"]] + +This should be called to clean up resources associated with [arg Key]. +Once this function has been called the key may not be used again. + +[list_end] + +[section "MODES OF OPERATION"] + +[list_begin definitions] +[def "Electronic Code Book (ECB)"] +ECB is the basic mode of all block ciphers. Each block is encrypted +independently and so identical plain text will produce identical +output when encrypted with the same key. Any encryption errors will +only affect a single block however this is vulnerable to known +plaintext attacks. + +[def "Cipher Block Chaining (CBC)"] + +CBC mode uses the output of the last block encryption to affect the +current block. An initialization vector of the same size as the cipher +block size is used to handle the first block. The initialization +vector should be chosen randomly and transmitted as the first block of +the output. Errors in encryption affect the current block and the next +block after which the cipher will correct itself. CBC is the most +commonly used mode in software encryption. + +[def "Cipher Feedback (CFB)"] + +CFB mode can be used to convert block ciphers into stream ciphers. In +CFB mode the initialization vector is encrypted and the output is then +xor'd with the plaintext stream. The result is then used as the +initialization vector for the next round. Errors will affect the +current block and the next block. + +[def "Output Feedback (OFB)"] +OFB is similar to CFB except that the output of the cipher is fed back +into the next round and not the xor'd plain text. This means that +errors only affect a single block but the cipher is more vulnerable to +attack. + +[list_end] + +[section EXAMPLES] + +[example { +% set ciphertext [DES::des -mode cbc -dir encrypt -key $secret $plaintext] +% set plaintext [DES::des -mode cbc -dir decrypt -key $secret $ciphertext] +}] + +[example { +set iv [string repeat \\0 8] +set Key [DES::Init cbc \\0\\1\\2\\3\\4\\5\\6\\7 $iv] +set ciphertext [DES::Encrypt $Key "somedata"] +append ciphertext [DES::Encrypt $Key "moredata"] +DES::Reset $Key $iv +set plaintext [DES::Decrypt $Key $ciphertext] +DES::Final $Key +}] + +[section "REFERENCES"] + +[list_begin enumerated] + +[enum] + "Data Encryption Standard", + Federal Information Processing Standards Publication 46-3, 1999, + ([uri http://csrc.nist.gov/publications/fips/fips46-3/fips46-3.pdf]) + +[enum] + "TclDES: munitions-grade Tcl scripting" + [uri http://tcldes.sourceforge.net/] + +[list_end] + +[section "AUTHORS"] +Jochen C Loewer, +Mac Cody, +Pat Thoyts + +[vset CATEGORY des] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/des/des.tcl b/tcllib/modules/des/des.tcl new file mode 100644 index 0000000..a2d0bd3 --- /dev/null +++ b/tcllib/modules/des/des.tcl @@ -0,0 +1,272 @@ +# des.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Tcllib wrapper for the DES package. This wrapper provides the same +# programming API that tcllib uses for AES and Blowfish. We require a +# DES implementation and use either TclDES or TclDESjr to get DES +# and/or 3DES +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2 + +if {[catch {package require tclDES 1.0.0}]} { + package require tclDESjr 1.0.0 +} + +namespace eval DES { + variable uid + if {![info exists uid]} { set uid 0 } +} + +proc ::DES::Init {mode key iv {weak 0}} { + variable uid + set Key [namespace current]::[incr uid] + upvar #0 $Key state + if {[string length $key] % 8 != 0} { + return -code error "invalid key length of\ + [expr {[string length $key] * 8}] bits:\ + DES requires 64 bit keys (56 bits plus parity bits)" + } + array set state [list M $mode I $iv K [des::keyset create $key $weak]] + return $Key +} + +proc ::DES::Encrypt {Key data} { + upvar #0 $Key state + set iv $state(I) + set r [des::encrypt $state(K) $data $state(M) iv] + set state(I) $iv + return $r +} + +proc ::DES::Decrypt {Key data} { + upvar #0 $Key state + set iv $state(I) + set r [des::decrypt $state(K) $data $state(M) iv] + set state(I) $iv + return $r +} + +proc ::DES::Reset {Key iv} { + upvar #0 $Key state + set state(I) $iv + return +} + +proc ::DES::Final {Key} { + upvar #0 $Key state + des::keyset destroy $state(K) + # FRINK: nocheck + unset $Key +} +# ------------------------------------------------------------------------- + +# Backwards compatability - here we re-implement the DES 0.8 procs using the +# current implementation. +# +# -- DO NOT USE THESE FUNCTIONS IN NEW CODE-- +# +proc ::DES::GetKey {mode keydata keyvarname} { + set weak 1 + switch -exact -- $mode { + -encrypt { set dir encrypt ; set vnc 0 } + -encryptVNC { set dir encrypt ; set vnc 1 } + -decrypt { set dir decrypt ; set vnc 0 } + -decryptVNC { set dir decrypt ; set vnc 1 } + default { + return -code error "invalid mode \"$mode\":\ + must be one of -encrypt, -decrypt, -encryptVNC or -decryptVNC" + } + } + if {$vnc} { set keydata [ReverseBytes $keydata] } + upvar $keyvarname Key + set Key [Init ecb $keydata [string repeat \0 8] $weak] + upvar $Key state + array set state [list dir $dir] + return +} + +proc ::DES::DesBlock {data keyvarname} { + upvar $keyvarname Key + upvar #0 $Key state + if {[string equal $state(dir) "encrypt"]} { + set r [Encrypt $Key $data] + } else { + set r [Decrypt $Key $data] + } + return $r +} + +proc ::DES::ReverseBytes {data} { + binary scan $data b* bin + return [binary format B* $bin] +} + +# ------------------------------------------------------------------------- + +proc ::DES::SetOneOf {lst item} { + set ndx [lsearch -glob $lst "${item}*"] + if {$ndx == -1} { + set err [join $lst ", "] + return -code error "invalid mode \"$item\": must be one of $err" + } + return [lindex $lst $ndx] +} + +proc ::DES::CheckSize {what size thing} { + if {[string length $thing] != $size} { + return -code error "invalid value for $what: must be $size bytes long" + } + return $thing +} + +proc ::DES::Pad {data blocksize {fill \0}} { + set len [string length $data] + if {$len == 0} { + set data [string repeat $fill $blocksize] + } elseif {($len % $blocksize) != 0} { + set pad [expr {$blocksize - ($len % $blocksize)}] + append data [string repeat $fill $pad] + } + return $data +} + +proc ::DES::Pop {varname {nth 0}} { + upvar $varname args + set r [lindex $args $nth] + set args [lreplace $args $nth $nth] + return $r +} + +proc ::DES::Hex {data} { + binary scan $data H* r + return $r +} + +proc ::DES::des {args} { + array set opts { + -dir encrypt -mode cbc -key {} -in {} -out {} -chunksize 4096 -hex 0 -weak 0 old 0 + } + set blocksize 8 + set opts(-iv) [string repeat \0 $blocksize] + set modes {ecb cbc cfb ofb} + set dirs {encrypt decrypt} + while {[string match -* [set option [lindex $args 0]]]} { + switch -exact -- $option { + -mode { + set M [Pop args 1] + if {[catch {set mode [SetOneOf $modes $M]} err]} { + if {[catch {SetOneOf {encode decode} $M}]} { + return -code error $err + } else { + # someone is using the old interface, therefore ecb + set mode ecb + set opts(-weak) 1 + set opts(old) 1 + set opts(-dir) [expr {[string match en* $M] ? "encrypt" : "decrypt"}] + } + } + set opts(-mode) $mode + } + -dir { set opts(-dir) [SetOneOf $dirs [Pop args 1]] } + -iv { set opts(-iv) [Pop args 1] } + -key { set opts(-key) [Pop args 1] } + -in { set opts(-in) [Pop args 1] } + -out { set opts(-out) [Pop args 1] } + -chunksize { set opts(-chunksize) [Pop args 1] } + -hex { set opts(-hex) 1 } + -weak { set opts(-weak) 1 } + -- { Pop args ; break } + default { + set err [join [lsort [array names opts -*]] ", "] + return -code error "bad option \"$option\":\ + must be one of $err" + } + } + Pop args + } + + if {$opts(-key) == {}} { + return -code error "no key provided: the -key option is required" + } + + # pad the key if backwards compat required + if {$opts(old)} { + set pad [expr {8 - ([string length $opts(-key)] % 8)}] + if {$pad != 8} { + append opts(-key) [string repeat \0 $pad] + } + } + + set r {} + if {$opts(-in) == {}} { + + if {[llength $args] != 1} { + return -code error "wrong \# args:\ + should be \"des ?options...? -key keydata plaintext\"" + } + + set data [Pad [lindex $args 0] $blocksize] + set Key [Init $opts(-mode) $opts(-key) $opts(-iv) $opts(-weak)] + if {[string equal $opts(-dir) "encrypt"]} { + set r [Encrypt $Key $data] + } else { + set r [Decrypt $Key $data] + } + + if {$opts(-out) != {}} { + puts -nonewline $opts(-out) $r + set r {} + } + Final $Key + + } else { + + if {[llength $args] != 0} { + return -code error "wrong \# args:\ + should be \"des ?options...? -key keydata -in channel\"" + } + + set Key [Init $opts(-mode) $opts(-key) $opts(-iv) $opts(-weak)] + upvar $Key state + set state(reading) 1 + if {[string equal $opts(-dir) "encrypt"]} { + set state(cmd) Encrypt + } else { + set state(cmd) Decrypt + } + set state(output) "" + fileevent $opts(-in) readable \ + [list [namespace origin Chunk] \ + $Key $opts(-in) $opts(-out) $opts(-chunksize)] + if {[info commands ::tkwait] != {}} { + tkwait variable [subst $Key](reading) + } else { + vwait [subst $Key](reading) + } + if {$opts(-out) == {}} { + set r $state(output) + } + Final $Key + + } + + if {$opts(-hex)} { + set r [Hex $r] + } + return $r +} + +# ------------------------------------------------------------------------- + +package provide des 1.1.0 + +# ------------------------------------------------------------------------- +# +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/des/des.test b/tcllib/modules/des/des.test new file mode 100644 index 0000000..a34f984 --- /dev/null +++ b/tcllib/modules/des/des.test @@ -0,0 +1,408 @@ +# -*- tcl -*- +# Commands covered: DES (Data Encryption Standard) +# +# This file contains a collection of tests for one or more of the commands +# the BLOB-X extension. Sourcing this file into Tcl runs the +# tests and generates output for errors. No output means no errors were +# found. +# +# Original Copyright (c) 1996 Andreas Kupries (a.kupries@westend.com) +# Modifications Copyright (c) 2003 Patrick Thoyts <patthoyts@users.sf.net> +# +# Modified from TrfCrypt tests +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: des.test,v 1.7 2007/07/05 13:19:20 patthoyts Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +testing { + # Base implementation first, then the package for the public API + useLocal [expr { + [tcltest::testConstraint no3des] ? + "tcldesjr.tcl" : + "tcldes.tcl"}] tclDES ::des + useLocal des.tcl des ::DES +} + +# ------------------------------------------------------------------------- + +if {[llength [package provide tclDES]] != 0} { + puts "> pure Tcl : TclDES [package provide tclDES]" +} elseif {[llength [package provide tclDESjr]] != 0} { + puts "> pure Tcl : TclDESjr [package provide tclDESjr]" +} else { + puts "> unknown base implementation!" +} + +# ------------------------------------------------------------------------- +# Setup any constraints +# + +tcltest::testConstraint 3des \ + [llength [package provide tclDES]] + +# ------------------------------------------------------------------------- + +# These are the NBS test vectors for the S-box tests +# See http://csrc.nist.gov/publications/nistpubs/800-20/800-20.pdf Table A.4 +# +set vectors { + 1 weak 0000000000000000 0000000000000000 8CA64DE9C1B123A7 + 2 weak FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF 7359B2163E4EDC58 + 3 ok 3000000000000000 1000000000000001 958E6E627A05557B + 4 ok 1111111111111111 1111111111111111 F40379AB9E0EC533 + 5 ok 0123456789ABCDEF 1111111111111111 17668DFC7292532D + 6 ok 1111111111111111 0123456789ABCDEF 8A5AE1F81AB8F2DD + 7 weak 0000000000000000 0000000000000000 8CA64DE9C1B123A7 + 8 ok FEDCBA9876543210 0123456789ABCDEF ED39D950FA74BCC4 + 9 ok 7CA110454A1A6E57 01A1D6D039776742 690F5B0D9A26939B + 10 ok 0131D9619DC1376E 5CD54CA83DEF57DA 7A389D10354BD271 + 11 ok 07A1133E4A0B2686 0248D43806F67172 868EBB51CAB4599A + 12 ok 3849674C2602319E 51454B582DDF440A 7178876E01F19B2A + 13 ok 04B915BA43FEB5B6 42FD443059577FA2 AF37FB421F8C4095 + 14 ok 0113B970FD34F2CE 059B5E0851CF143A 86A560F10EC6D85B + 15 ok 0170F175468FB5E6 0756D8E0774761D2 0CD3DA020021DC09 + 16 ok 43297FAD38E373FE 762514B829BF486A EA676B2CB7DB2B7A + 17 ok 07A7137045DA2A16 3BDD119049372802 DFD64A815CAF1A0F + 18 ok 04689104C2FD3B2F 26955F6835AF609A 5C513C9C4886C088 + 19 ok 37D06BB516CB7546 164D5E404F275232 0A2AEEAE3FF4AB77 + 20 ok 1F08260D1AC2465E 6B056E18759F5CCA EF1BF03E5DFA575A + 21 ok 584023641ABA6176 004BD6EF09176062 88BF0DB6D70DEE56 + 22 ok 025816164629B007 480D39006EE762F2 A1F9915541020B56 + 23 ok 49793EBC79B3258F 437540C8698F3CFA 6FBF1CAFCFFD0556 + 24 ok 4FB05E1515AB73A7 072D43A077075292 2F22E49BAB7CA1AC + 25 ok 49E95D6D4CA229BF 02FE55778117F12A 5A6B612CC26CCE4A + 26 ok 018310DC409B26D6 1D9D5C5018F728C2 5F4C038ED12B2E41 + 27 ok 1C587F1C13924FEF 305532286D6F295A 63FAC0D034D9F793 + 28 weak 0101010101010101 0123456789ABCDEF 617B3A0CE8F07100 + 29 weak 1F1F1F1F0E0E0E0E 0123456789ABCDEF DB958605F8C8C606 + 30 ok E0FEE0FEF1FEF1FE 0123456789ABCDEF EDBFD1C66C29CCC7 + 31 weak 0000000000000000 FFFFFFFFFFFFFFFF 355550B2150E2451 + 32 weak FFFFFFFFFFFFFFFF 0000000000000000 CAAAAF4DEAF1DBAE + 33 ok 0123456789ABCDEF 0000000000000000 D5D44FF720683D0D + 34 ok FEDCBA9876543210 FFFFFFFFFFFFFFFF 2A2BB008DF97C2F2 +} + +foreach {N W K I O} $vectors { + if {[string equal $W "weak"]} { + if {[llength [package provide tclDES]] != 0} { + set Re {1 {Key 1 is weak!}} + set Rd {1 {Key 1 is weak!}} + } else { + set Re {1 {The key is weak!}} + set Rd {1 {The key is weak!}} + } + set Ro [list 0 $O] + } else { + set Re [list 0 $O] + set Rd [list 0 $I] + set Ro [list 0 $O] + } + + test des-1.${N}-enc {des-ecb encryption} { + list [catch { + set k [binary format H* $K] + set p [binary format H* $I] + set s [DES::des -dir encrypt -mode ecb -key $k $p] + binary scan $s H* h + string toupper $h + } res] $res + } $Re + + test des-1.${N}-dec {des-ecb decryption} { + list [catch { + set k [binary format H* $K] + set p [binary format H* $O] + set s [DES::des -dir decrypt -mode ecb -key $k $p] + binary scan $s H* h + string toupper $h + } res] $res + } $Rd + + test des-1.${N}-old {backwards compat check (encryption)} { + list [catch { + set s [DES::des -mode encode -key [binary format H* $K] [binary format H* $I]] + binary scan $s H* h; string toupper $h + } res] $res + } $Ro +} + +# DESTEST - see http://theory.lcs.mit.edu/~rivest/destest.txt +test des-2.0 {destest} { + list [catch { + set X [binary format H* 9474B8E8C73BCA7D] + for {set n 0} {$n < 16} {incr n} { + set x [lindex $X $n] + if {$n & 1} { + lappend X [DES::des -mode ecb -dir decrypt -key $x $x] + } else { + lappend X [DES::des -mode ecb -dir encrypt -key $x $x] + } + } + DES::Hex [lindex $X end] + } res] $res +} [list 0 1b1a2ddb4c642438] + +set vectors { +0 8000000000000000 95F8A5E5DD31D900 +1 4000000000000000 DD7F121CA5015619 +2 2000000000000000 2E8653104F3834EA +3 1000000000000000 4BD388FF6CD81D4F +4 0800000000000000 20B9E767B2FB1456 +5 0400000000000000 55579380D77138EF +6 0200000000000000 6CC5DEFAAF04512F +7 0100000000000000 0D9F279BA5D87260 +8 0080000000000000 D9031B0271BD5A0A +9 0040000000000000 424250B37C3DD951 +10 0020000000000000 B8061B7ECD9A21E5 +11 0010000000000000 F15D0F286B65BD28 +12 0008000000000000 ADD0CC8D6E5DEBA1 +13 0004000000000000 E6D5F82752AD63D1 +14 0002000000000000 ECBFE3BD3F591A5E +15 0001000000000000 F356834379D165CD +16 0000800000000000 2B9F982F20037FA9 +17 0000400000000000 889DE068A16F0BE6 +18 0000200000000000 E19E275D846A1298 +19 0000100000000000 329A8ED523D71AEC +20 0000080000000000 E7FCE22557D23C97 +21 0000040000000000 12A9F5817FF2D65D +22 0000020000000000 A484C3AD38DC9C19 +23 0000010000000000 FBE00A8A1EF8AD72 +24 0000008000000000 750D079407521363 +25 0000004000000000 64FEED9C724C2FAF +26 0000002000000000 F02B263B328E2B60 +27 0000001000000000 9D64555A9A10B852 +28 0000000800000000 D106FF0BED5255D7 +29 0000000400000000 E1652C6B138C64A5 +30 0000000200000000 E428581186EC8F46 +31 0000000100000000 AEB5F5EDE22D1A36 +32 0000000080000000 E943D7568AEC0C5C +33 0000000040000000 DF98C8276F54B04B +34 0000000020000000 B160E4680F6C696F +35 0000000010000000 FA0752B07D9C4AB8 +36 0000000008000000 CA3A2B036DBC8502 +37 0000000004000000 5E0905517BB59BCF +38 0000000002000000 814EEB3B91D90726 +39 0000000001000000 4D49DB1532919C9F +40 0000000000800000 25EB5FC3F8CF0621 +41 0000000000400000 AB6A20C0620D1C6F +42 0000000000200000 79E90DBC98F92CCA +43 0000000000100000 866ECEDD8072BB0E +44 0000000000080000 8B54536F2F3E64A8 +45 0000000000040000 EA51D3975595B86B +46 0000000000020000 CAFFC6AC4542DE31 +47 0000000000010000 8DD45A2DDF90796C +48 0000000000008000 1029D55E880EC2D0 +49 0000000000004000 5D86CB23639DBEA9 +50 0000000000002000 1D1CA853AE7C0C5F +51 0000000000001000 CE332329248F3228 +52 0000000000000800 8405D1ABE24FB942 +53 0000000000000400 E643D78090CA4207 +54 0000000000000200 48221B9937748A23 +55 0000000000000100 DD7C0BBD61FAFD54 +56 0000000000000080 2FBC291A570DB5C4 +57 0000000000000040 E07C30D7E4E26E12 +58 0000000000000020 0953E2258E8E90A1 +59 0000000000000010 5B711BC4CEEBF2EE +60 0000000000000008 CC083F1E6D9E85F6 +61 0000000000000004 D2FD8867D50D2DFE +62 0000000000000002 06E7EA22CE92708F +63 0000000000000001 166B40B44ABA4BD6 +} + +foreach {N I O} $vectors { + test des-3.${N}-e {FIPS 800-20 Table A.1} { + list [catch { + set k [binary format H* 0101010101010101] + set i [binary format H* $I] + string toupper [DES::des -hex -weak -mode ecb -dir encrypt -key $k $i] + } res] $res + } [list 0 $O] + test des-3.${N}-d {FIPS 800-20 Table A.1} { + list [catch { + set k [binary format H* 0101010101010101] + set o [binary format H* $O] + string toupper [DES::des -hex -weak -mode ecb -dir decrypt -key $k $o] + } res] $res + } [list 0 $I] +} + +# NBS PUB 800 Table A.5 +#ROUND INPUTBLOCK 1 CIPHERTEXT1 INPUTBLOCK 2 CIPHERTEXT2 INPUTBLOCK 3 CIPHERTEXT3 +set vectors { +0 8000000000000000 95f8a5e5dd31d900 d555555555555555 f7552ab6cb21e2bc 2aaaaaaaaaaaaaaa 5a48d3de869557fd +1 4000000000000000 dd7f121ca5015619 1555555555555555 e0c2af1ebd89a262 eaaaaaaaaaaaaaaa f15ee2019a5b547c +2 2000000000000000 2e8653104f3834ea 7555555555555555 05b865a1e49ed109 8aaaaaaaaaaaaaaa 3bee595ef860316a +3 1000000000000000 4bd388ff6cd81d4f 4555555555555555 b447313fc704d321 baaaaaaaaaaaaaaa f6089ca9b722765c +4 0800000000000000 20b9e767b2fb1456 5d55555555555555 c39193d42381b313 a2aaaaaaaaaaaaaa af15a8e9b2c14de5 +5 0400000000000000 55579380d77138ef 5155555555555555 6a2afdae188494b8 aeaaaaaaaaaaaaaa 45089186180bd591 +6 0200000000000000 6cc5defaaf04512f 5755555555555555 1359f4d663a3209c a8aaaaaaaaaaaaaa 280d3ae3a00cfbc9 +7 0100000000000000 0d9f279ba5d87260 5455555555555555 4a035e6a81d1314b abaaaaaaaaaaaaaa d27eb94e56c3172a +8 0080000000000000 d9031b0271bd5a0a 55d5555555555555 4334b5fe1b7f5320 aa2aaaaaaaaaaaaa b0555ab990b7e95c +9 0040000000000000 424250b37c3dd951 5515555555555555 f41a29e0d31107b4 aaeaaaaaaaaaaaaa f54f2bd8e2eb2bc6 +10 0020000000000000 b8061b7ecd9a21e5 5575555555555555 c8eb2e340855325b aa8aaaaaaaaaaaaa d51175259c607fb4 +11 0010000000000000 f15d0f286b65bd28 5545555555555555 b75847a2f3f2458a aabaaaaaaaaaaaaa 72ea3aadb569af43 +12 0008000000000000 add0cc8d6e5deba1 555d555555555555 be433af4c5ae0f97 aaa2aaaaaaaaaaaa 9b003151e8602b7d +13 0004000000000000 e6d5f82752ad63d1 5551555555555555 f68101d125e2e284 aaaeaaaaaaaaaaaa fc1463bb9bba9e11 +14 0002000000000000 ecbfe3bd3f591a5e 5557555555555555 fa510732fa871094 aaa8aaaaaaaaaaaa 65f94c59c59b06e1 +15 0001000000000000 f356834379d165cd 5554555555555555 458d97a8b6ebd0d7 aaabaaaaaaaaaaaa fbcfc086f8111572 +16 0000800000000000 2b9f982f20037fa9 5555d55555555555 f4169ca3fc6799ed aaaa2aaaaaaaaaaa 68c9e70b9de8db79 +17 0000400000000000 889de068a16f0be6 5555155555555555 f47b9f01a5ee74e9 aaaaeaaaaaaaaaaa 63fc8ec1421399b8 +18 0000200000000000 e19e275d846a1298 5555755555555555 ee26a403caca387d aaaa8aaaaaaaaaaa 3f1d10e9a1a44a92 +19 0000100000000000 329a8ed523d71aec 5555455555555555 af7e5ad1d9f4ecf8 aaaabaaaaaaaaaaa e3f663de44003f9b +20 0000080000000000 e7fce22557d23c97 55555d5555555555 bb04e854f99f6352 aaaaa2aaaaaaaaaa bc2452fd13e00dcc +21 0000040000000000 12a9f5817ff2d65d 5555515555555555 01f57b1e69290d90 aaaaaeaaaaaaaaaa 4432a11e1c320e7a +22 0000020000000000 a484c3ad38dc9c19 5555575555555555 8ae9dee849b46527 aaaaa8aaaaaaaaaa a1e9e67f13f932b3 +23 0000010000000000 fbe00a8a1ef8ad72 5555545555555555 cb706efba6b5110e aaaaabaaaaaaaaaa 6fd1d0793c1b7af2 +24 0000008000000000 750d079407521363 555555d555555555 b8b27d1286bdbb26 aaaaaa2aaaaaaaaa 3d2c39f9d26b589e +25 0000004000000000 64feed9c724c2faf 5555551555555555 9862c9d770558095 aaaaaaeaaaaaaaaa e3a7abc88132ad7d +26 0000002000000000 f02b263b328e2b60 5555557555555555 a213c5c56fdca139 aaaaaa8aaaaaaaaa 08cd945738a222c8 +27 0000001000000000 9d64555a9a10b852 5555554555555555 a3bebc0e23ab87f2 aaaaaabaaaaaaaaa 568fa34d2fc7225e +28 0000000800000000 d106ff0bed5255d7 5555555d55555555 c32c19229d84e2b4 aaaaaaa2aaaaaaaa 3771887d7266b49d +29 0000000400000000 e1652c6b138c64a5 5555555155555555 e628ceae5cb3bb34 aaaaaaaeaaaaaaaa edd6029a6b80a442 +30 0000000200000000 e428581186ec8f46 5555555755555555 5924454953ad5732 aaaaaaa8aaaaaaaa 0313da097aec4a43 +31 0000000100000000 aeb5f5ede22d1a36 5555555455555555 7cc987f5fb33b813 aaaaaaabaaaaaaaa 91f5b30f015b4a54 +32 0000000080000000 e943d7568aec0c5c 55555555d5555555 88e3dd1448c4e0ff aaaaaaaa2aaaaaaa 1e60759f038beec1 +33 0000000040000000 df98c8276f54b04b 5555555515555555 a49d286e5dfc6143 aaaaaaaaeaaaaaaa 97061699383bbfe0 +34 0000000020000000 b160e4680f6c696f 5555555575555555 a5206a311e9c2515 aaaaaaaa8aaaaaaa 311f3c96e071f173 +35 0000000010000000 fa0752b07d9c4ab8 5555555545555555 b6e4686a8b957cf2 aaaaaaaabaaaaaaa 1a6849edcb701b07 +36 0000000008000000 ca3a2b036dbc8502 555555555d555555 af1200418fd37fdd aaaaaaaaa2aaaaaa fa5b2fa26d03558b +37 0000000004000000 5e0905517bb59bcf 5555555551555555 487deccf0fde5b88 aaaaaaaaaeaaaaaa bcaa0b7b7b3464c5 +38 0000000002000000 814eeb3b91d90726 5555555557555555 456a1865905ed57d aaaaaaaaa8aaaaaa 3d245b501c6abb74 +39 0000000001000000 4d49db1532919c9f 5555555554555555 3e2601fa20895e62 aaaaaaaaabaaaaaa 62133d9330e2e86b +40 0000000000800000 25eb5fc3f8cf0621 5555555555d55555 58da89972266a7e3 aaaaaaaaaa2aaaaa 5d7d6bd225890b4d +41 0000000000400000 ab6a20c0620d1c6f 5555555555155555 feaca17e5dd05c87 aaaaaaaaaaeaaaaa db36baba70c3b9af +42 0000000000200000 79e90dbc98f92cca 5555555555755555 88249b73e99c5ac0 aaaaaaaaaa8aaaaa a2f5ea90c2179ab4 +43 0000000000100000 866ecedd8072bb0e 5555555555455555 5f8add8784cc3174 aaaaaaaaaabaaaaa 70470a07cb34e109 +44 0000000000080000 8b54536f2f3e64a8 55555555555d5555 cd8dc942ae2bb175 aaaaaaaaaaa2aaaa 659610094ab3824e +45 0000000000040000 ea51d3975595b86b 5555555555515555 cf8442863e68e644 aaaaaaaaaaaeaaaa 26e6223634c857a3 +46 0000000000020000 caffc6ac4542de31 5555555555575555 16952dc89c0acd65 aaaaaaaaaaa8aaaa ddd0a647be96041f +47 0000000000010000 8dd45a2ddf90796c 5555555555545555 8a4fca2b00c49807 aaaaaaaaaaabaaaa 363219d8cec5a9f3 +48 0000000000008000 1029d55e880ec2d0 555555555555d555 b40225aea121c8d3 aaaaaaaaaaaa2aaa bb5710f9dc8dde46 +49 0000000000004000 5d86cb23639dbea9 5555555555551555 711c066c13222f1c aaaaaaaaaaaaeaaa ae527ed311a25ea2 +50 0000000000002000 1d1ca853ae7c0c5f 5555555555557555 4fb69c832db68026 aaaaaaaaaaaa8aaa af94496800a32656 +51 0000000000001000 ce332329248f3228 5555555555554555 f24c7444edf1c394 aaaaaaaaaaaabaaa c55d7544a1eae274 +52 0000000000000800 8405d1abe24fb942 5555555555555d55 6be457abc511e87c aaaaaaaaaaaaa2aa 9ba49db251748896 +53 0000000000000400 e643d78090ca4207 5555555555555155 6136fefebb0c8118 aaaaaaaaaaaaaeaa 3d19267de9c12e7b +54 0000000000000200 48221b9937748a23 5555555555555755 d23a8dfe39c98883 aaaaaaaaaaaaa8aa 5ce84637532650c8 +55 0000000000000100 dd7c0bbd61fafd54 5555555555555455 afe2e34f009924e2 aaaaaaaaaaaaabaa d43941ab72932bb0 +56 0000000000000080 2fbc291a570db5c4 55555555555555d5 0adcf552ec1754c6 aaaaaaaaaaaaaa2a 816c454ba7894865 +57 0000000000000040 e07c30d7e4e26e12 5555555555555515 c06e80c5238135bb aaaaaaaaaaaaaaea 74bc744f10f63889 +58 0000000000000020 0953e2258e8e90a1 5555555555555575 0912754e7c42f637 aaaaaaaaaaaaaa8a 3d2565d9bf62cdbd +59 0000000000000010 5b711bc4ceebf2ee 5555555555555545 b4f82967c658adb8 aaaaaaaaaaaaaaba a2e13c5701a60444 +60 0000000000000008 cc083f1e6d9e85f6 555555555555555d 006fa12a796ac4d3 aaaaaaaaaaaaaaa2 cbe2873fd6f63048 +61 0000000000000004 d2fd8867d50d2dfe 5555555555555551 1a4a364616460d44 aaaaaaaaaaaaaaae cc6adcef1be975ef +62 0000000000000002 06e7ea22ce92708f 5555555555555557 f307b5bcd44f3d8d aaaaaaaaaaaaaaa8 991d770b2bf051dc +63 0000000000000001 166b40b44aba4bd6 5555555555555554 9cb1c3932c005c49 aaaaaaaaaaaaaaab 17d8e9c374d14494 +} + +foreach {N I0 O0 I1 O1 I2 O2} $vectors { + test des-4.$N {} { + list [catch { + set K [string repeat \x01 8] + set v0 [string repeat \x00 8] ; set i0 [binary format H* $I0] + set v1 [string repeat \x55 8] ; set i1 [binary format H* $I1] + set v2 [string repeat \xaa 8] ; set i2 [binary format H* $I2] + set r0 [DES::des -weak -mode ecb -dir enc -key $K -iv $v0 $i0] + set r1 [DES::des -weak -mode ecb -dir enc -key $K -iv $v1 $i1] + set r2 [DES::des -weak -mode ecb -dir enc -key $K -iv $v2 $i2] + DES::Hex $r0$r1$r2 + } res] $res + } [list 0 $O0$O1$O2] +} + +# Old VNC support - DES 0.8 supported VNC by using an explicit mode. +# In fact is is only necessary to revese the key bit order - use +# ReverseBytes for this. +# +set vectors { + 0 0000000000000000 0000000000000000 8ca64de9c1b123a7 + 1 0001020304050607 0000000000000000 77dad0b666306c37 + 2 0123456789abcdef 0000000000000000 acad343b2a0ac9e0 + 3 0123456789abcdef 0123456789abcdef 6e09a37726dd560c +} +foreach {N K I O} $vectors { + test des-5.${N}-e {Check VNC DES support (encrypt)} { + catch {unset k} + list [catch { + DES::GetKey -encryptVNC [binary format H* $K] k + set r [DES::DesBlock [binary format H* $I] k] + unset k + DES::Hex $r + } res] $res + } [list 0 $O] + + test des-5.${N}-d {Check VNC DES support (decrypt)} { + catch {unset k} + list [catch { + DES::GetKey -decryptVNC [binary format H* $K] k + set r [DES::DesBlock [binary format H* $O] k] + unset k + DES::Hex $r + } res] $res + } [list 0 $I] +} +foreach {N K I O} $vectors { + test des-6.${N}-e {Check reverse key} { + list [catch { + set Key [DES::Init ecb [DES::ReverseBytes [binary format H* $K]] [string repeat \0 8] 1] + set r [DES::Encrypt $Key [binary format H* $I]] + DES::Final $Key + DES::Hex $r + } res] $res + } [list 0 $O] +} + + +for {set N 0} {$N < 9} {incr N} { + if {$N == 0} { + set check [list 1 "invalid message size: the message may not be empty"] + } else { + set check [list 0 8ca64de9c1b123a7] + } + + test des-7.${N} {Check block length} { + list [catch { + DES::des -hex -weak -mode ecb -dir decrypt \ + -key [string repeat \0 8] \ + [string repeat \0 ${N}] + } res] $res + } [list 0 8ca64de9c1b123a7] + + test des-8.${N} {Check block length} { + list [catch { + set Key [DES::Init ecb [string repeat \0 8] [string repeat \0 8] 1] + set r [DES::Encrypt $Key [string repeat \0 ${N}]] + DES::Final $Key + DES::Hex $r + } res] $res + } $check +} + +test des-9.1 {Backwards compatability - key padding} { + list [catch { + set key [DES::des -mode encode -key secret helloworld01] + binary scan $key H* r + set r + } res] $res +} {0 7669422b7cce615fe4cae65c4e25eb36} + +# ------------------------------------------------------------------------- + +#catch {unset in out key} +testsuiteCleanup + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/des/pkgIndex.tcl b/tcllib/modules/des/pkgIndex.tcl new file mode 100644 index 0000000..a620cb7 --- /dev/null +++ b/tcllib/modules/des/pkgIndex.tcl @@ -0,0 +1,7 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} { + # PRAGMA: returnok + return +} +package ifneeded des 1.1.0 [list source [file join $dir des.tcl]] +package ifneeded tclDES 1.0.0 [list source [file join $dir tcldes.tcl]] +package ifneeded tclDESjr 1.0.0 [list source [file join $dir tcldesjr.tcl]] diff --git a/tcllib/modules/des/tcldes.man b/tcllib/modules/des/tcldes.man new file mode 100644 index 0000000..509cec2 --- /dev/null +++ b/tcllib/modules/des/tcldes.man @@ -0,0 +1,25 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin tcldes n 1.1] +[see_also des(n)] +[keywords 3DES] +[keywords {block cipher}] +[keywords {data integrity}] +[keywords DES] +[keywords encryption] +[keywords security] +[copyright {2005, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[moddesc {Data Encryption Standard (DES)}] +[titledesc {Implementation of the DES and triple-DES ciphers}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require tclDES 1] +[description] +[para] + +The [package tclDES] package is a helper package for [package des]. + +[para] Please see the documentation of [package des] for details. + +[vset CATEGORY des] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/des/tcldes.tcl b/tcllib/modules/des/tcldes.tcl new file mode 100644 index 0000000..4b57d5f --- /dev/null +++ b/tcllib/modules/des/tcldes.tcl @@ -0,0 +1,1089 @@ +# des.tcl +# $Revision: 1.1 $ +# $Date: 2005/09/26 09:16:59 $ +# +# Port of Javascript implementation to Tcl 8.4 by Mac A. Cody, +# October, 2002 - February, 2003 +# August, 2003 - Separated key set generation from encryption/decryption. +# Renamed "des" procedure to "block" to differentiate from the +# "stream" procedure used for CFB and OFB modes. +# Modified the "encrypt" and "decrypt" procedures to support +# CFB and OFB modes. Changed the procedure arguments. +# Added the "stream" procedure to support CFB and OFB modes. +# June, 2004 - Corrected input vector bug in stream-mode processing. Added +# support for feedback vector storage and management function. +# This enables a stream of data to be processed over several calls +# to the encryptor or decryptor. +# September, 2004 - Added feedback vector to the CBC mode of operation to allow +# a large data set to be processed over several calls to the +# encryptor or decryptor. +# October, 2004 - Added test for weak keys in the createKeys procedure. +# +# Paul Tero, July 2001 +# http://www.shopable.co.uk/des.html +# +# Optimised for performance with large blocks by Michael Hayworth, +# November 2001, http://www.netdealing.com +# +# This software is copyrighted (c) 2003, 2004 by Mac A. Cody. All rights +# reserved. The following terms apply to all files associated with +# the software unless explicitly disclaimed in individual files or +# directories. + +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software for any purpose, provided that existing +# copyright notices are retained in all copies and that this notice is +# included verbatim in any distributions. No written agreement, license, +# or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors and +# need not follow the licensing terms described here, provided that the +# new terms are clearly indicated on the first page of each file where +# they apply. + +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. + +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. + +# GOVERNMENT USE: If you are acquiring this software on behalf of the +# U.S. government, the Government shall have only "Restricted Rights" +# in the software and related documentation as defined in the Federal +# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +# are acquiring the software on behalf of the Department of Defense, the +# software shall be classified as "Commercial Computer Software" and the +# Government shall have only "Restricted Rights" as defined in Clause +# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +# authors grant the U.S. Government and others acting in its behalf +# permission to use and distribute the software in accordance with the +# terms specified in this license. +namespace eval des { + variable keysets + variable WeakKeysError + if {![info exists WeakKeysError]} { set WeakKeysError 1 } + set keysets(ndx) 1 + # Produre: keyset - Create or destroy a keyset created from a 64-bit + # DES key or a 192-bit 3DES key. + # Inputs: + # oper : The operation to be performed. This will be either "create" + # (make a new keyset) or "destroy" (delete an existing keyset). + # The meaning of the argument "value" depends of the operation + # performed. An error is generated if "oper" is not "create" + # or "destroy". + # + # value : If the argument "oper" is "create", then "value" is the 64-bit + # DES key or the 192-bit 3DES key. (Note: The lsb of each byte + # is ignored; odd parity is not required). If the argument + # "oper" is "destroy", then "value" is a handle to a keyset that + # was created previously. + # + # weak: If true then weak keys are allowed. The default is to raise an + # error when a weak key is seen. + # Output: + # If the argument "oper" is "create", then the output is a handle to the + # keyset stored in the des namespace. If the argument "oper" is + # "destroy", then nothing is returned. + proc keyset {oper value {weak 0}} { + variable keysets + set newset {} + switch -exact -- $oper { + create { + # Create a new keyset handle. + set newset keyset$keysets(ndx) + # Create key set + set keysets($newset) [createKeys $value $weak] + # Never use that keyset handle index again. + incr keysets(ndx) + } + destroy { + # Determine if the keyset handle is valid. + if {[array names keysets $value] != {}} { + # Delete the handle and corresponding keyset. + unset keysets($value) + } else { + error "The keyset handle \"$value\" is invalid!" + } + } + default { + error {The operator must be either "create" or "destroy".} + } + } + return $newset + } + + # Procedure: encrypt - Encryption front-end for the des procedure + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted. + # mode : DES mode ecb (default), cbc, cfb, or ofb. + # iv : Name of the initialization vector used in CBC, CFB, + # and OFB modes. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted data string. + proc encrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { + switch -exact -- $mode { + ecb { + return [block $keyset $message 1 0] + } + cbc - + ofb - + cfb { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] == 0} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + switch -exact -- $mode { + cbc { + return [block $keyset $message 1 1 ivec] + } + ofb { + return [stream $keyset $message 1 0 ivec $kbits] + } + cfb { + return [stream $keyset $message 1 1 ivec $kbits] + } + } + } + default { + error {Mode must be ecb, cbc, cfb, or ofb.} + } + } + } + + # Procedure: decrypt - Decryption front-end for the des procedure + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be decrypted. + # mode : DES mode ecb (default), cbc, cfb, or ofb. + # iv : Name of the initialization vector used in CBC, CFB, + # and OFB modes. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted or decrypted data string. + proc decrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { + switch -exact -- $mode { + ecb { + return [block $keyset $message 0 0] + } + cbc - + ofb - + cfb { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + switch -exact -- $mode { + cbc { + return [block $keyset $message 0 1 ivec] + } + ofb { + return [stream $keyset $message 0 0 ivec $kbits] + } + cfb { + return [stream $keyset $message 0 1 ivec $kbits] + } + } + } + default { + error {Mode must be ecb, cbc, cfb, or ofb.} + } + } + } + + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + + variable desEncrypt {0 32 2} + variable desDecrypt {30 -2 -2} + variable des3Encrypt {0 32 2 62 30 -2 64 96 2} + variable des3Decrypt {94 62 -2 32 64 2 30 -2 -2} + + # Procedure: block - DES ECB and CBC mode support + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted or decrypted (Note: For encryption, + # the string is extended with null characters to an integral + # multiple of eight bytes. For decryption, the string length + # must be an integral multiple of eight bytes. + # encrypt : Perform encryption (1) or decryption (0) + # mode : DES mode 1=CBC, 0=ECB (default). + # iv : Name of the variable containing the initialization vector + # used in CBC mode. The value must be 64 bits in length. + # Output: + # The encrypted or decrypted data string. + proc block {keyset message encrypt {mode 0} {iv {}}} { + variable spfunction1 + variable spfunction2 + variable spfunction3 + variable spfunction4 + variable spfunction5 + variable spfunction6 + variable spfunction7 + variable spfunction8 + variable desEncrypt + variable desDecrypt + variable des3Encrypt + variable des3Decrypt + variable keysets + + # Determine if the keyset handle is valid. + if {[array names keysets $keyset] != {}} { + # Acquire the 16 or 48 subkeys we will need + set keys $keysets($keyset) + } else { + error "The keyset handle \"$keyset\" is invalid!" + } + set m 0 + set cbcleft 0x00; set cbcleft2 0x00 + set cbcright 0x00; set cbcright2 0x00 + set len [string length $message]; + if {$len == 0} { + return -code error "invalid message size: the message may not be empty" + } + set chunk 0; + # Set up the loops for single and triple des + set iterations [expr {[llength $keys] == 32 ? 3 : 9}]; + if {$iterations == 3} { + expr {$encrypt ? [set looping $desEncrypt] : \ + [set looping $desDecrypt]} + } else { + expr {$encrypt ? [set looping $des3Encrypt] : \ + [set looping $des3Decrypt]} + } + + # Pad the message out with null bytes. + append message "\0\0\0\0\0\0\0\0" + + # Store the result here + set result {}; + set tempresult {}; + + # CBC mode + if {$mode == 1} { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + if {[string length $ivec] != 8} { + return -code error "invalid initialization vector size:\ + the initialization vector must be 8 bytes" + } + } + # Use the input vector as the intial vector. + binary scan $ivec H8H8 cbcleftTemp cbcrightTemp + set cbcleft "0x$cbcleftTemp" + set cbcright "0x$cbcrightTemp" + } + + # Loop through each 64 bit chunk of the message + while {$m < $len} { + binary scan $message x${m}H8H8 lefttemp righttemp + set left {} + append left "0x" $lefttemp + set right {} + append right "0x" $righttemp + incr m 8 + + #puts "Left start: $left"; + #puts "Right start: $right"; + # For Cipher Block Chaining mode, xor the + # message with the previous result. + if {$mode == 1} { + if {$encrypt} { + set left [expr {$left ^ $cbcleft}] + set right [expr {$right ^ $cbcright}] + } else { + set cbcleft2 $cbcleft; + set cbcright2 $cbcright; + set cbcleft $left; + set cbcright $right; + } + } + + #puts "Left mode: $left"; + #puts "Right mode: $right"; + #puts "cbcleft: $cbcleft"; + #puts "cbcleft2: $cbcleft2"; + #puts "cbcright: $cbcright"; + #puts "cbcright2: $cbcright2"; + + # First each 64 but chunk of the message + # must be permuted according to IP. + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 2)}]; + + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + + set left [expr {((($left << 1) & 0xffffffff) | \ + (($left >> 31) & 0x00000001))}]; + set right [expr {((($right << 1) & 0xffffffff) | \ + (($right >> 31) & 0x00000001))}]; + + #puts "Left IP: [format %x $left]"; + #puts "Right IP: [format %x $right]"; + + # Do this either 1 or 3 times for each chunk of the message + for {set j 0} {$j < $iterations} {incr j 3} { + set endloop [lindex $looping [expr {$j + 1}]]; + set loopinc [lindex $looping [expr {$j + 2}]]; + + #puts "endloop: $endloop"; + #puts "loopinc: $loopinc"; + + # Now go through and perform the encryption or decryption + for {set i [lindex $looping $j]} \ + {$i != $endloop} {incr i $loopinc} { + # For efficiency + set right1 [expr {$right ^ [lindex $keys $i]}]; + set right2 [expr {((($right >> 4) & 0x0fffffff) | \ + (($right << 28) & 0xffffffff)) ^ \ + [lindex $keys [expr {$i + 1}]]}]; + + # puts "right1: [format %x $right1]"; + # puts "right2: [format %x $right2]"; + + # The result is attained by passing these + # bytes through the S selection functions. + set temp $left; + set left $right; + set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ + [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ + [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ + [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ + [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ + [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ + [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ + [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; + + # puts "Left iter: [format %x $left]"; + # puts "Right iter: [format %x $right]"; + + } + set temp $left; + set left $right; + set right $temp; # Unreverse left and right + }; # For either 1 or 3 iterations + + #puts "Left Iterated: [format %x $left]"; + #puts "Right Iterated: [format %x $right]"; + + # Move then each one bit to the right + set left [expr {((($left >> 1) & 0x7fffffff) \ + | (($left << 31) & 0xffffffff))}]; + set right [expr {((($right >> 1) & 0x7fffffff) \ + | (($right << 31) & 0xffffffff))}]; + + #puts "Left shifted: [format %x $left]"; + #puts "Right shifted: [format %x $right]"; + + # Now perform IP-1, which is IP in the opposite direction + set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + + #puts "Left IP-1: [format %x $left]"; + #puts "Right IP-1: [format %x $right]"; + + # For Cipher Block Chaining mode, xor + # the message with the previous result. + if {$mode == 1} { + if {$encrypt} { + set cbcleft $left; + set cbcright $right; + } else { + set left [expr {$left ^ $cbcleft2}]; + set right [expr {$right ^ $cbcright2}]; + } + } + + append tempresult \ + [binary format H16 [format %08x%08x $left $right]] + + #puts "Left final: [format %x $left]"; + #puts "Right final: [format %x $right]"; + + incr chunk 8; + if {$chunk == 512} { + append result $tempresult + set tempresult {}; + set chunk 0; + } + }; # For every 8 characters, or 64 bits in the message + + if {$mode == 1} { + if {$encrypt} { + # Save the left and right registers to the feedback vector. + set ivec [binary format H* \ + [format %08x $left][format %08x $right]] + } else { + set ivec [binary format H* \ + [format %08x $cbcleft][format %08x $cbcright]] + } + } + + # Return the result as an array + return ${result}$tempresult + }; # End of block + + # Procedure: stream - DES CFB and OFB mode support + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted or decrypted (Note: The length of the + # string is dependent upon the value of kbits. Remember that + # the string is part of a stream of data, so it must be sized + # properly for subsequent encryptions/decryptions to be + # correct. See the man page for correct message lengths for + # values of kbits). + # encrypt : Perform encryption (1) or decryption (0) + # mode : DES mode 0=OFB, 1=CFB. + # iv : Name of variable containing the initialization vector. The + # value must be 64 bits in length with the first 64-L bits set + # to zero. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted or decrypted data string. + proc stream {keyset message encrypt mode iv {kbits 64}} { + variable spfunction1 + variable spfunction2 + variable spfunction3 + variable spfunction4 + variable spfunction5 + variable spfunction6 + variable spfunction7 + variable spfunction8 + variable desEncrypt + variable des3Encrypt + variable keysets + + # Determine if the keyset handle is valid. + if {[array names keysets $keyset] != {}} { + # Acquire the 16 or 48 subkeys we will need. + set keys $keysets($keyset) + } else { + error "The keyset handle \"$keyset\" is invalid!" + } + + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + + # Determine if message length (in bits) + # is not an integral number of kbits. + set len [string length $message]; + #puts "len: $len, kbits: $kbits" + if {($kbits < 1) || ($kbits > 64)} { + error "The valid values of kbits are 1 through 64." + } elseif {($kbits % 8) != 0} { + set blockSize [expr {$kbits + (8 - ($kbits % 8))}] + set fail [expr {(($len * 8) / $blockSize) % $kbits}] + } else { + set blockSize [expr {$kbits / 8}] + set fail [expr {$len % $blockSize}] + } + if {$fail} { + error "Data length (in bits) is not an integral number of kbits." + } + + set m 0 + set n 0 + set chunk 0; + # Set up the loops for single and triple des + set iterations [expr {[llength $keys] == 32 ? 3 : 9}]; + if {$iterations == 3} { + set looping $desEncrypt + } else { + set looping $des3Encrypt + } + + # Set up shifting values. Used for both CFB and OFB modes. + if {$kbits < 32} { + # Only some bits from left output are needed. + set kOutShift [expr {32 - $kbits}] + set kOutMask [expr {0x7fffffff >> (31 - $kbits)}] + # Determine number of message bytes needed per iteration. + set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] + # Determine number of message bits needed per iteration. + set msgBits [expr {$msgBytes * 8}] + set msgBitsSub1 [expr {$msgBits - 1}] + # Define bit caches. + set bitCacheIn {} + set bitCacheOut {} + # Variable used to remove bits 0 through + # kbits-1 in the input bit cache. + set kbitsSub1 [expr {$kbits - 1}] + # Variable used to remove leading dummy binary bits. + set xbits [expr {32 - $kbits}] + } elseif {$kbits == 32} { + # Only bits of left output are used. + # Four messages bytes are needed per iteration. + set msgBytes 4 + set xbits 32 + } elseif {$kbits < 64} { + # All bits from left output are needed. + set kOutShiftLeft [expr {$kbits - 32}] + # Some bits from right output are needed. + set kOutShiftRight [expr {64 - $kbits}] + set kOutMaskRight [expr {0x7fffffff >> (63 - $kbits)}] + # Determine number of message bytes needed per iteration. + set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] + # Determine number of message bits needed per iteration. + set msgBits [expr {$msgBytes * 8}] + set msgBitsSub1 [expr {$msgBits - 1}] + # Define bit caches. + set bitCacheIn {} + set bitCacheOut {} + # Variable used to remove bits 0 through + # kbits-1 in the input bit cache. + set kbitsSub1 [expr {$kbits - 1}] + # Variable used to remove leading dummy binary bits. + set xbits [expr {64 - $kbits}] + } else { + # All 64 bits of output are used. + # Eight messages bytes are needed per iteration. + set msgBytes 8 + set xbits 0 + } + + # Store the result here + set result {} + set tempresult {} + + # Set up the initialization vector bitstream + binary scan $ivec H8H8 leftTemp rightTemp + set left "0x$leftTemp" + set right "0x$rightTemp" + #puts "Retrieved Feedback vector: $fbvec" + #puts "Start: |$left| |$right|" + + # Loop through each 64 bit chunk of the message + while {$m < $len} { + # puts "Left start: $left"; + # puts "Right start: $right"; + + # First each 64 but chunk of the + # message must be permuted according to IP. + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + + set left [expr {((($left << 1) & 0xffffffff) | \ + (($left >> 31) & 0x00000001))}]; + set right [expr {((($right << 1) & 0xffffffff) | \ + (($right >> 31) & 0x00000001))}]; + + #puts "Left IP: [format %x $left]"; + #puts "Right IP: [format %x $right]"; + + # Do this either 1 or 3 times for each chunk of the message + for {set j 0} {$j < $iterations} {incr j 3} { + set endloop [lindex $looping [expr {$j + 1}]]; + set loopinc [lindex $looping [expr {$j + 2}]]; + + #puts "endloop: $endloop"; + #puts "loopinc: $loopinc"; + + # Now go through and perform the encryption or decryption + for {set i [lindex $looping $j]} \ + {$i != $endloop} {incr i $loopinc} { + # For efficiency + set right1 [expr {$right ^ [lindex $keys $i]}]; + set right2 [expr {((($right >> 4) & 0x0fffffff) | \ + (($right << 28) & 0xffffffff)) ^ \ + [lindex $keys [expr {$i + 1}]]}]; + + # puts "right1: [format %x $right1]"; + # puts "right2: [format %x $right2]"; + + # The result is attained by passing these + # bytes through the S selection functions. + set temp $left; + set left $right; + set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ + [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ + [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ + [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ + [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ + [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ + [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ + [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; + + # puts "Left iter: [format %x $left]"; + # puts "Right iter: [format %x $right]"; + + } + set temp $left; + set left $right; + set right $temp; # Unreverse left and right + }; # For either 1 or 3 iterations + + #puts "Left Iterated: [format %x $left]"; + #puts "Right Iterated: [format %x $right]"; + + # Move then each one bit to the right + set left [expr {((($left >> 1) & 0x7fffffff) | \ + (($left << 31) & 0xffffffff))}]; + set right [expr {((($right >> 1) & 0x7fffffff) | \ + (($right << 31) & 0xffffffff))}]; + + #puts "Left shifted: [format %x $left]"; + #puts "Right shifted: [format %x $right]"; + + # Now perform IP-1, which is IP in the opposite direction + set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + + #puts "Left IP-1: [format %x $left]"; + #puts "Right IP-1: [format %x $right]"; + + # Extract the "kbits" most significant bits from the output block. + if {$kbits < 32} { + # Only some bits from left output are needed. + set kData [expr {($left >> $kOutShift) & $kOutMask}] + set newBits {} + # If necessary, copy message bytes into input bit cache. + if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { + if {$len - $n < $msgBytes} { + set lastBits [expr {($len - $n) * 8}] + ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] + binary scan $message x${n}B$lastBits newBits + } else { + # Extract "msgBytes" whole bytes as bits + ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] + binary scan $message x${n}B$msgBits newBits + } + incr n $msgBytes + #puts " $newBits $n [expr {$len - $n}]" + # Add the bits to the input bit cache. + append bitCacheIn $newBits + } + #puts -nonewline "In bit cache: $bitCacheIn" + # Set up message data from input bit cache. + binary scan [binary format B32 [format %032s [string range $bitCacheIn 0 $kbitsSub1]]] H8 temp + set msgData "0x$temp" + # Mix message bits with crypto bits. + set mixData [expr {$msgData ^ $kData}] + # Discard collected bits from the input bit cache. + set bitCacheIn [string range $bitCacheIn $kbits end] + #puts " After: $bitCacheIn" + # Convert back to a bit stream and append to the output bit cache. + # Only the lower kbits are wanted. + binary scan [binary format H8 [format %08x $mixData]] B32 msgOut + append bitCacheOut [string range $msgOut $xbits end] + #puts -nonewline "Out bit cache: $bitCacheOut" + # If there are sufficient bits, move bytes to the temporary holding string. + if {[string length $bitCacheOut] >= $msgBits} { + append tempresult [binary format B$msgBits [string range $bitCacheOut 0 $msgBitsSub1]] + set bitCacheOut [string range $bitCacheOut $msgBits end] + #puts -nonewline " After: $bitCacheOut" + incr m $msgBytes + ###puts "$m bytes output" + incr chunk $msgBytes + } + #puts "" + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set temp [expr {($right << $kbits) & 0xffffffff}] + set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] + set right [expr {$temp | $mixData}] + } else { + set temp [expr {($right << $kbits) & 0xffffffff}] + set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] + set right [expr {$temp | $msgData}] + } + } + } elseif {$kbits == 32} { + # Only bits of left output are used. + set kData $left + # Four messages bytes are needed per iteration. + binary scan $message x${m}H8 temp + incr m 4 + incr chunk 4 + set msgData "0x$temp" + # Mix message bits with crypto bits. + set mixData [expr {$msgData ^ $kData}] + # Move bytes to the temporary holding string. + append tempresult [binary format H8 [format %08x $mixData]] + # For CFB mode + if {$mode == 1} { + set left $right + if {$encrypt} { + set right $mixData + } else { + set right $msgData + } + } + } elseif {$kbits < 64} { + set kDataLeft [expr {($left >> $kOutShiftRight) & $kOutMaskRight}] + set temp [expr {($left << $kOutShiftLeft) & 0xffffffff}] + set kDataRight [expr {(($right >> $kOutShiftRight) & $kOutMaskRight) | $temp}] + # If necessary, copy message bytes into input bit cache. + if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { + if {$len - $n < $msgBytes} { + set lastBits [expr {($len - $n) * 8}] + ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] + binary scan $message x${n}B$lastBits newBits + } else { + # Extract "msgBytes" whole bytes as bits + ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] + binary scan $message x${n}B$msgBits newBits + } + incr n $msgBytes + # Add the bits to the input bit cache. + append bitCacheIn $newBits + } + # Set up message data from input bit cache. + # puts "Bits from cache: [set temp [string range $bitCacheIn 0 $kbitsSub1]]" + # puts "Length of bit string: [string length $temp]" + binary scan [binary format B64 [format %064s [string range $bitCacheIn 0 $kbitsSub1]]] H8H8 leftTemp rightTemp + set msgDataLeft "0x$leftTemp" + set msgDataRight "0x$rightTemp" + # puts "msgDataLeft: $msgDataLeft" + # puts "msgDataRight: $msgDataRight" + # puts "kDataLeft: [format 0x%08x $kDataLeft]" + # puts "kDataRight: [format 0x%08x $kDataRight]" + # Mix message bits with crypto bits. + set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] + set mixDataRight [expr {$msgDataRight ^ $kDataRight}] + # puts "mixDataLeft: $mixDataLeft" + # puts "mixDataRight: $mixDataRight" + # puts "mixDataLeft: [format 0x%08x $mixDataLeft]" + # puts "mixDataRight: [format 0x%08x $mixDataRight]" + # Discard collected bits from the input bit cache. + set bitCacheIn [string range $bitCacheIn $kbits end] + # Convert back to a bit stream and + # append to the output bit cache. + # Only the lower kbits are wanted. + binary scan \ + [binary format H8H8 \ + [format %08x $mixDataLeft] \ + [format %08x $mixDataRight]] B64 msgOut + append bitCacheOut [string range $msgOut $xbits end] + # If there are sufficient bits, move + # bytes to the temporary holding string. + if {[string length $bitCacheOut] >= $msgBits} { + append tempresult \ + [binary format B$msgBits \ + [string range $bitCacheOut 0 $msgBitsSub1]] + set bitCacheOut [string range $bitCacheOut $msgBits end] + incr m $msgBytes + incr chunk $msgBytes + } + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set temp \ + [expr {($right << $kOutShiftRight) & 0xffffffff}] + set left [expr {$temp | $mixDataLeft}] + set right $mixDataRight + } else { + set temp \ + [expr {($right << $kOutShiftRight) & 0xffffffff}] + set left [expr {$temp | $msgDataLeft}] + set right $msgDataRight + } + } + } else { + # All 64 bits of output are used. + set kDataLeft $left + set kDataRight $right + # Eight messages bytes are needed per iteration. + binary scan $message x${m}H8H8 leftTemp rightTemp + incr m 8 + incr chunk 8 + set msgDataLeft "0x$leftTemp" + set msgDataRight "0x$rightTemp" + # Mix message bits with crypto bits. + set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] + set mixDataRight [expr {$msgDataRight ^ $kDataRight}] + # Move bytes to the temporary holding string. + append tempresult \ + [binary format H16 \ + [format %08x%08x $mixDataLeft $mixDataRight]] + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set left $mixDataLeft + set right $mixDataRight + } else { + set left $msgDataLeft + set right $msgDataRight + } + } + } + + #puts "Left final: [format %x $left]"; + #puts "Right final: [format %x $right]"; + + if {$chunk >= 512} { + append result $tempresult + set tempresult {}; + set chunk 0; + } + }; # For every 8 characters, or 64 bits in the message + #puts "End: |[format 0x%08x $left]| |[format 0x%08x $right]|" + # Save the left and right registers to the feedback vector. + set ivec [binary format H* [format %08x $left][format %08x $right]] + #puts "Saved Feedback vector: $fbvectors($fbvector)" + + append result $tempresult + if {[string length $result] > $len} { + set result [string replace $result $len end] + } + # Return the result as an array + return $result + }; # End of stream + + variable pc2bytes0 [list 0 0x4 0x20000000 0x20000004 0x10000 0x10004 0x20010000 0x20010004 0x200 0x204 0x20000200 0x20000204 0x10200 0x10204 0x20010200 0x20010204] + variable pc2bytes1 [list 0 0x1 0x100000 0x100001 0x4000000 0x4000001 0x4100000 0x4100001 0x100 0x101 0x100100 0x100101 0x4000100 0x4000101 0x4100100 0x4100101] + variable pc2bytes2 [list 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808] + variable pc2bytes3 [list 0 0x200000 0x8000000 0x8200000 0x2000 0x202000 0x8002000 0x8202000 0x20000 0x220000 0x8020000 0x8220000 0x22000 0x222000 0x8022000 0x8222000] + variable pc2bytes4 [list 0 0x40000 0x10 0x40010 0 0x40000 0x10 0x40010 0x1000 0x41000 0x1010 0x41010 0x1000 0x41000 0x1010 0x41010] + variable pc2bytes5 [list 0 0x400 0x20 0x420 0 0x400 0x20 0x420 0x2000000 0x2000400 0x2000020 0x2000420 0x2000000 0x2000400 0x2000020 0x2000420] + variable pc2bytes6 [list 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002] + variable pc2bytes7 [list 0 0x10000 0x800 0x10800 0x20000000 0x20010000 0x20000800 0x20010800 0x20000 0x30000 0x20800 0x30800 0x20020000 0x20030000 0x20020800 0x20030800] + variable pc2bytes8 [list 0 0x40000 0 0x40000 0x2 0x40002 0x2 0x40002 0x2000000 0x2040000 0x2000000 0x2040000 0x2000002 0x2040002 0x2000002 0x2040002] + variable pc2bytes9 [list 0 0x10000000 0x8 0x10000008 0 0x10000000 0x8 0x10000008 0x400 0x10000400 0x408 0x10000408 0x400 0x10000400 0x408 0x10000408] + variable pc2bytes10 [list 0 0x20 0 0x20 0x100000 0x100020 0x100000 0x100020 0x2000 0x2020 0x2000 0x2020 0x102000 0x102020 0x102000 0x102020] + variable pc2bytes11 [list 0 0x1000000 0x200 0x1000200 0x200000 0x1200000 0x200200 0x1200200 0x4000000 0x5000000 0x4000200 0x5000200 0x4200000 0x5200000 0x4200200 0x5200200] + variable pc2bytes12 [list 0 0x1000 0x8000000 0x8001000 0x80000 0x81000 0x8080000 0x8081000 0x10 0x1010 0x8000010 0x8001010 0x80010 0x81010 0x8080010 0x8081010] + variable pc2bytes13 [list 0 0x4 0x100 0x104 0 0x4 0x100 0x104 0x1 0x5 0x101 0x105 0x1 0x5 0x101 0x105] + + # Now define the left shifts which need to be done + variable shifts {0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0}; + + # Procedure: createKeys + # Input: + # key : The 64-bit DES key or the 192-bit 3DES key + # (Note: The lsb of each byte is ignored; odd parity + # is not required). + # + # weak: If true then weak keys are allowed. The default is to raise an + # error when a weak key is seen. + # Output: + # The 16 (DES) or 48 (3DES) subkeys. + proc createKeys {key {weak 0}} { + variable pc2bytes0 + variable pc2bytes1 + variable pc2bytes2 + variable pc2bytes3 + variable pc2bytes4 + variable pc2bytes5 + variable pc2bytes6 + variable pc2bytes7 + variable pc2bytes8 + variable pc2bytes9 + variable pc2bytes10 + variable pc2bytes11 + variable pc2bytes12 + variable pc2bytes13 + variable shifts + + # How many iterations (1 for des, 3 for triple des) + set iterations [expr {([string length $key] >= 24) ? 3 : 1}]; + # Stores the return keys + set keys {} + # Other variables + set lefttemp {}; set righttemp {} + set m 0 + # Either 1 or 3 iterations + for {set j 0} {$j < $iterations} {incr j} { + binary scan $key x${m}H8H8 lefttemp righttemp + set left {} + append left "0x" $lefttemp + set right {} + append right "0x" $righttemp + incr m 8 + + #puts "Left key: $left" + #puts "Right key: $right" + + # Test for weak keys + if {! $weak} { + set maskedLeft [expr {$left & 0xfefefefe}] + set maskedRight [expr {$right & 0xfefefefe}] + if {($maskedLeft == 0x00000000) \ + && ($maskedRight == 0x00000000)} { + error "Key [expr {$j + 1}] is weak!" + } elseif {($maskedLeft == 0x1e1e1e1e) \ + && ($maskedRight == 0x0e0e0e0e)} { + error "Key [expr {$j + 1}] is weak!" + } elseif {($maskedLeft == 0xe0e0e0e0) \ + && ($maskedRight == 0xf0f0f0f0)} { + error "Key [expr {$j + 1}] is weak!" + } elseif {($maskedLeft == 0xfefefefe) \ + && ($maskedRight == 0xfefefefe)} { + error "Key [expr {$j + 1}] is weak!" + } + } + + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 4)}] + set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 16)}] + set temp [expr {(($left >> 2) ^ $right) & 0x33333333}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 2)}] + set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 16)}] + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 1)}] + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 8)}] + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 1)}] + + #puts "Left key PC1: [format %x $left]" + #puts "Right key PC1: [format %x $right]" + + # The right side needs to be shifted and to get + # the last four bits of the left side + set temp [expr {($left << 8) | (($right >> 20) & 0x000000f0)}]; + # Left needs to be put upside down + set left [expr {($right << 24) | (($right << 8) & 0x00ff0000) | \ + (($right >> 8) & 0x0000ff00) \ + | (($right >> 24) & 0x000000f0)}]; + set right $temp; + + #puts "Left key juggle: [format %x $left]" + #puts "Right key juggle: [format %x $right]" + + # Now go through and perform these + # shifts on the left and right keys. + foreach i $shifts { + # Shift the keys either one or two bits to the left. + if {$i} { + set left [expr {($left << 2) \ + | (($left >> 26) & 0x0000003f)}]; + set right [expr {($right << 2) \ + | (($right >> 26) & 0x0000003f)}]; + } else { + set left [expr {($left << 1) \ + | (($left >> 27) & 0x0000001f)}]; + set right [expr {($right << 1) \ + | (($right >> 27) & 0x0000001f)}]; + } + set left [expr {$left & 0xfffffff0}]; + set right [expr {$right & 0xfffffff0}]; + + # Now apply PC-2, in such a way that E is easier when + # encrypting or decrypting this conversion will look like PC-2 + # except only the last 6 bits of each byte are used rather than + # 48 consecutive bits and the order of lines will be according + # to how the S selection functions will be applied: S2, S4, S6, + # S8, S1, S3, S5, S7. + set lefttemp [expr {[lindex $pc2bytes0 [expr {($left >> 28) & 0x0000000f}]] | \ + [lindex $pc2bytes1 [expr {($left >> 24) & 0x0000000f}]] | \ + [lindex $pc2bytes2 [expr {($left >> 20) & 0x0000000f}]] | \ + [lindex $pc2bytes3 [expr {($left >> 16) & 0x0000000f}]] | \ + [lindex $pc2bytes4 [expr {($left >> 12) & 0x0000000f}]] | \ + [lindex $pc2bytes5 [expr {($left >> 8) & 0x0000000f}]] | \ + [lindex $pc2bytes6 [expr {($left >> 4) & 0x0000000f}]]}]; + set righttemp [expr {[lindex $pc2bytes7 [expr {($right >> 28) & 0x0000000f}]] | \ + [lindex $pc2bytes8 [expr {($right >> 24) & 0x0000000f}]] | \ + [lindex $pc2bytes9 [expr {($right >> 20) & 0x0000000f}]] | \ + [lindex $pc2bytes10 [expr {($right >> 16) & 0x0000000f}]] | \ + [lindex $pc2bytes11 [expr {($right >> 12) & 0x0000000f}]] | \ + [lindex $pc2bytes12 [expr {($right >> 8) & 0x0000000f}]] | \ + [lindex $pc2bytes13 [expr {($right >> 4) & 0x0000000f}]]}]; + set temp [expr {(($righttemp >> 16) ^ $lefttemp) & 0x0000ffff}]; + lappend keys [expr {$lefttemp ^ $temp}]; + lappend keys [expr {$righttemp ^ ($temp << 16)}]; + } + }; # For each iteration. + # Return the keys we've created. + return $keys; + }; # End of createKeys. +}; # End of des namespace eval. + +package provide tclDES 1.0.0 diff --git a/tcllib/modules/des/tcldesjr.man b/tcllib/modules/des/tcldesjr.man new file mode 100644 index 0000000..ebdb936 --- /dev/null +++ b/tcllib/modules/des/tcldesjr.man @@ -0,0 +1,25 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin tcldes n 1.1] +[see_also des(n)] +[keywords 3DES] +[keywords {block cipher}] +[keywords {data integrity}] +[keywords DES] +[keywords encryption] +[keywords security] +[copyright {2005, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[moddesc {Data Encryption Standard (DES)}] +[titledesc {Implementation of the DES and triple-DES ciphers}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require tclDESjr 1] +[description] +[para] + +The [package tclDESjr] package is a helper package for [package des]. + +[para] Please see the documentation of [package des] for details. + +[vset CATEGORY des] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/des/tcldesjr.tcl b/tcllib/modules/des/tcldesjr.tcl new file mode 100644 index 0000000..a1775a7 --- /dev/null +++ b/tcllib/modules/des/tcldesjr.tcl @@ -0,0 +1,1055 @@ +# desjr.tcl +# $Revision: 1.1 $ +# $Date: 2005/09/26 09:16:59 $ +# +# Port of Javascript implementation to Tcl 8.4 by Mac A. Cody, +# 3DES functionality removed, February, 2003 +# July, 2003 - Separated key set generation from encryption/decryption. +# Renamed "des" procedure to "block" to differentiate from the +# "stream" procedure used for CFB and OFB modes. +# Modified the "encrypt" and "decrypt" procedures to support +# CFB and OFB modes. Changed the procedure arguments. +# August, 2003 - Added the "stream" procedure to support CFB and OFB modes. +# June, 2004 - Corrected input vector bug in stream-mode processing. Added +# support for feedback vector storage and management function. +# This enables a stream of data to be processed over several calls +# to the encryptor or decryptor. +# September, 2004 - Added feedback vector to the CBC mode of operation to allow +# a large data set to be processed over several calls to the +# encryptor or decryptor. +# October, 2004 - Added test for weak keys in the createKeys procedure. +# +# Paul Tero, July 2001 +# http://www.shopable.co.uk/des.html +# +# Optimised for performance with large blocks by Michael Hayworth, +# November 2001, http://www.netdealing.com +# +# This software is copyrighted (c) 2003, 2004 by Mac A. Cody. All rights +# reserved. The following terms apply to all files associated with +# the software unless explicitly disclaimed in individual files or +# directories. + +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software for any purpose, provided that existing +# copyright notices are retained in all copies and that this notice is +# included verbatim in any distributions. No written agreement, license, +# or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors and +# need not follow the licensing terms described here, provided that the +# new terms are clearly indicated on the first page of each file where +# they apply. + +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. + +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. + +# GOVERNMENT USE: If you are acquiring this software on behalf of the +# U.S. government, the Government shall have only "Restricted Rights" +# in the software and related documentation as defined in the Federal +# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +# are acquiring the software on behalf of the Department of Defense, the +# software shall be classified as "Commercial Computer Software" and the +# Government shall have only "Restricted Rights" as defined in Clause +# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +# authors grant the U.S. Government and others acting in its behalf +# permission to use and distribute the software in accordance with the +# terms specified in this license. +namespace eval des { + variable keysets + set keysets(ndx) 1 + # Produre: keyset - Create or destroy a keyset created + # from a 64-bit DES key. + # Inputs: + # oper : The operation to be performed. This will be either "create" + # (make a new keyset) or "destroy" (delete an existing keyset). + # The meaning of the argument "value" depends of the operation + # performed. An error is generated if "oper" is not "create" + # or "destroy". + # + # value : If the argument "oper" is "create", then "value" is the 64-bit + # DES key. (Note: The lsb of each byte is ignored; odd parity is + # not required). If the argument "oper" is "destroy", then + # "value" is a handle to a keyset that was created previously. + # + # weak: If true then weak keys are allowed. The default is to raise an + # error when a weak key is seen. + # Output: + # If the argument "oper" is "create", then the output is a handle to the + # keyset stored in the des namespace. If the argument "oper" is + # "destroy", then nothing is returned. + proc keyset {oper value {weak 0}} { + variable keysets + set newset {} + switch -exact -- $oper { + create { + # Create a new keyset handle. + set newset keyset$keysets(ndx) + # Create key set + set keysets($newset) [createKeys $value $weak] + # Never use that keyset handle index again. + incr keysets(ndx) + } + destroy { + # Determine if the keyset handle is valid. + if {[array names keysets $value] != {}} { + # Delete the handle and corresponding keyset. + unset keysets($value) + } else { + error "The keyset handle \"$value\" is invalid!" + } + } + default { + error {The operator must be either "create" or "destroy".} + } + } + return $newset + } + + # Procedure: encrypt - Encryption front-end for the des procedure + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted. + # mode : DES mode ecb (default), cbc, cfb, or ofb. + # iv : Name of the initialization vector used in CBC, CFB, + # and OFB modes. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted data string. + proc encrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { + switch -exact -- $mode { + ecb { + return [block $keyset $message 1 0] + } + cbc - + ofb - + cfb { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] == 0} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + switch -exact -- $mode { + cbc { + return [block $keyset $message 1 1 ivec] + } + ofb { + return [stream $keyset $message 1 0 ivec $kbits] + } + cfb { + return [stream $keyset $message 1 1 ivec $kbits] + } + } + } + default { + error {Mode must be ecb, cbc, cfb, or ofb.} + } + } + } + + # Procedure: decrypt - Decryption front-end for the des procedure + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be decrypted. + # mode : DES mode ecb (default), cbc, cfb, or ofb. + # iv : Name of the initialization vector used in CBC, CFB, + # and OFB modes. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted or decrypted data string. + proc decrypt {keyset message {mode ecb} {iv {}} {kbits 64}} { + switch -exact -- $mode { + ecb { + return [block $keyset $message 0 0] + } + cbc - + ofb - + cfb { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + switch -exact -- $mode { + cbc { + return [block $keyset $message 0 1 ivec] + } + ofb { + return [stream $keyset $message 0 0 ivec $kbits] + } + cfb { + return [stream $keyset $message 0 1 ivec $kbits] + } + } + } + default { + error {Mode must be ecb, cbc, cfb, or ofb.} + } + } + } + + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + 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]; + + variable desEncrypt {0 32 2} + variable desDecrypt {30 -2 -2} + + # Procedure: block - DES ECB and CBC mode support + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted or decrypted (Note: For encryption, + # the string is extended with null characters to an integral + # multiple of eight bytes. For decryption, the string length + # must be an integral multiple of eight bytes. + # encrypt : Perform encryption (1) or decryption (0) + # mode : DES mode 1=CBC, 0=ECB (default). + # iv : Name of the variable containing the initialization vector + # used in CBC mode. The value must be 64 bits in length. + # Output: + # The encrypted or decrypted data string. + proc block {keyset message encrypt {mode 0} {iv {}}} { + variable spfunction1 + variable spfunction2 + variable spfunction3 + variable spfunction4 + variable spfunction5 + variable spfunction6 + variable spfunction7 + variable spfunction8 + variable desEncrypt + variable desDecrypt + variable keysets + + # Determine if the keyset handle is valid. + if {[array names keysets $keyset] != {}} { + # Acquire the 16 or 48 subkeys we will need + set keys $keysets($keyset) + } else { + error "The keyset handle \"$keyset\" is invalid!" + } + set m 0 + set cbcleft 0x00; set cbcleft2 0x00 + set cbcright 0x00; set cbcright2 0x00 + set len [string length $message]; + if {$len == 0} { + return -code error "invalid message size: the message may not be empty" + } + set chunk 0; + # Set up the loops for des + expr {$encrypt ? [set looping $desEncrypt] : [set looping $desDecrypt]} + + # Pad the message out with null bytes. + append message "\0\0\0\0\0\0\0\0" + + # Store the result here + set result {}; + set tempresult {}; + + # CBC mode + if {$mode == 1} { + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + if {[string length $ivec] != 8} { + return -code error "invalid initialization vector size:\ + the initialization vector must be 8 bytes" + } + } + # Use the input vector as the intial vector. + binary scan $ivec H8H8 cbcleftTemp cbcrightTemp + set cbcleft "0x$cbcleftTemp" + set cbcright "0x$cbcrightTemp" + } + + # Loop through each 64 bit chunk of the message + while {$m < $len} { + binary scan $message x${m}H8H8 lefttemp righttemp + set left {} + append left "0x" $lefttemp + set right {} + append right "0x" $righttemp + incr m 8 + + #puts "Left start: $left"; + #puts "Right start: $right"; + # For Cipher Block Chaining mode, xor the + # message with the previous result. + if {$mode == 1} { + if {$encrypt} { + set left [expr {$left ^ $cbcleft}] + set right [expr {$right ^ $cbcright}] + } else { + set cbcleft2 $cbcleft; + set cbcright2 $cbcright; + set cbcleft $left; + set cbcright $right; + } + } + + #puts "Left mode: $left"; + #puts "Right mode: $right"; + #puts "cbcleft: $cbcleft"; + #puts "cbcleft2: $cbcleft2"; + #puts "cbcright: $cbcright"; + #puts "cbcright2: $cbcright2"; + + # First each 64 but chunk of the message + # must be permuted according to IP. + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 2)}]; + + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + + set left [expr {((($left << 1) & 0xffffffff) | \ + (($left >> 31) & 0x00000001))}]; + set right [expr {((($right << 1) & 0xffffffff) | \ + (($right >> 31) & 0x00000001))}]; + + #puts "Left IP: [format %x $left]"; + #puts "Right IP: [format %x $right]"; + + # Do this 1 time for each chunk of the message. + set endloop [lindex $looping 1]; + set loopinc [lindex $looping 2]; + + #puts "endloop: $endloop"; + #puts "loopinc: $loopinc"; + + # Now go through and perform the encryption or decryption. + for {set i [lindex $looping 0]} \ + {$i != $endloop} {incr i $loopinc} { + # For efficiency + set right1 [expr {$right ^ [lindex $keys $i]}]; + set right2 [expr {((($right >> 4) & 0x0fffffff) | \ + (($right << 28) & 0xffffffff)) ^ \ + [lindex $keys [expr {$i + 1}]]}]; + + # puts "right1: [format %x $right1]"; + # puts "right2: [format %x $right2]"; + + # The result is attained by passing these + # bytes through the S selection functions. + set temp $left; + set left $right; + set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ + [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ + [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ + [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ + [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ + [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ + [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ + [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; + + # puts "Left iter: [format %x $left]"; + # puts "Right iter: [format %x $right]"; + + } + set temp $left; + set left $right; + set right $temp; # Unreverse left and right. + + #puts "Left Iterated: [format %x $left]"; + #puts "Right Iterated: [format %x $right]"; + + # Move then each one bit to the right + set left [expr {((($left >> 1) & 0x7fffffff) \ + | (($left << 31) & 0xffffffff))}]; + set right [expr {((($right >> 1) & 0x7fffffff) \ + | (($right << 31) & 0xffffffff))}]; + + #puts "Left shifted: [format %x $left]"; + #puts "Right shifted: [format %x $right]"; + + # Now perform IP-1, which is IP in the opposite direction + set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + + #puts "Left IP-1: [format %x $left]"; + #puts "Right IP-1: [format %x $right]"; + + # For Cipher Block Chaining mode, xor + # the message with the previous result. + if {$mode == 1} { + if {$encrypt} { + set cbcleft $left; + set cbcright $right; + } else { + set left [expr {$left ^ $cbcleft2}]; + set right [expr {$right ^ $cbcright2}]; + } + } + + append tempresult \ + [binary format H16 [format %08x%08x $left $right]] + + #puts "Left final: [format %x $left]"; + #puts "Right final: [format %x $right]"; + + incr chunk 8; + if {$chunk == 512} { + append result $tempresult + set tempresult {}; + set chunk 0; + } + }; # For every 8 characters, or 64 bits in the message + + if {$mode == 1} { + if {$encrypt} { + # Save the left and right registers to the feedback vector. + set ivec [binary format H* \ + [format %08x $left][format %08x $right]] + } else { + set ivec [binary format H* \ + [format %08x $cbcleft][format %08x $cbcright]] + } + } + + # Return the result as an array + return ${result}$tempresult + }; # End of block + + # Procedure: stream - DES CFB and OFB mode support + # Inputs: + # keyset : Handle to an existing keyset. + # message : String to be encrypted or decrypted (Note: The length of the + # string is dependent upon the value of kbits. Remember that + # the string is part of a stream of data, so it must be sized + # properly for subsequent encryptions/decryptions to be + # correct. See the man page for correct message lengths for + # values of kbits). + # encrypt : Perform encryption (1) or decryption (0) + # mode : DES mode 0=OFB, 1=CFB. + # iv : Name of variable containing the initialization vector. The + # value must be 64 bits in length with the first 64-L bits set + # to zero. + # kbits : Number of bits in a data block (default of 64). + # Output: + # The encrypted or decrypted data string. + proc stream {keyset message encrypt mode iv {kbits 64}} { + variable spfunction1 + variable spfunction2 + variable spfunction3 + variable spfunction4 + variable spfunction5 + variable spfunction6 + variable spfunction7 + variable spfunction8 + variable desEncrypt + variable keysets + + # Determine if the keyset handle is valid. + if {[array names keysets $keyset] != {}} { + # Acquire the 16 subkeys we will need. + set keys $keysets($keyset) + } else { + error "The keyset handle \"$keyset\" is invalid!" + } + + # Is the initialization/feedback vector variable is valid? + if {[string length $iv] < 1} { + error "An initialization variable must be specified." + } else { + upvar $iv ivec + if {![info exists ivec]} { + error "The variable $iv does not exist." + } + } + + # Determine if message length (in bits) + # is not an integral number of kbits. + set len [string length $message]; + #puts "len: $len, kbits: $kbits" + if {($kbits < 1) || ($kbits > 64)} { + error "The valid values of kbits are 1 through 64." + } elseif {($kbits % 8) != 0} { + set blockSize [expr {$kbits + (8 - ($kbits % 8))}] + set fail [expr {(($len * 8) / $blockSize) % $kbits}] + } else { + set blockSize [expr {$kbits / 8}] + set fail [expr {$len % $blockSize}] + } + if {$fail} { + error "Data length (in bits) is not an integral number of kbits." + } + + set m 0 + set n 0 + set chunk 0; + # Set up the loops for des + set looping $desEncrypt + + # Set up shifting values. Used for both CFB and OFB modes. + if {$kbits < 32} { + # Only some bits from left output are needed. + set kOutShift [expr {32 - $kbits}] + set kOutMask [expr {0x7fffffff >> (31 - $kbits)}] + # Determine number of message bytes needed per iteration. + set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] + # Determine number of message bits needed per iteration. + set msgBits [expr {$msgBytes * 8}] + set msgBitsSub1 [expr {$msgBits - 1}] + # Define bit caches. + set bitCacheIn {} + set bitCacheOut {} + # Variable used to remove bits 0 through + # kbits-1 in the input bit cache. + set kbitsSub1 [expr {$kbits - 1}] + # Variable used to remove leading dummy binary bits. + set xbits [expr {32 - $kbits}] + } elseif {$kbits == 32} { + # Only bits of left output are used. + # Four messages bytes are needed per iteration. + set msgBytes 4 + set xbits 32 + } elseif {$kbits < 64} { + # All bits from left output are needed. + set kOutShiftLeft [expr {$kbits - 32}] + # Some bits from right output are needed. + set kOutShiftRight [expr {64 - $kbits}] + set kOutMaskRight [expr {0x7fffffff >> (63 - $kbits)}] + # Determine number of message bytes needed per iteration. + set msgBytes [expr {int(ceil(double($kbits) / 8.0))}] + # Determine number of message bits needed per iteration. + set msgBits [expr {$msgBytes * 8}] + set msgBitsSub1 [expr {$msgBits - 1}] + # Define bit caches. + set bitCacheIn {} + set bitCacheOut {} + # Variable used to remove bits 0 through + # kbits-1 in the input bit cache. + set kbitsSub1 [expr {$kbits - 1}] + # Variable used to remove leading dummy binary bits. + set xbits [expr {64 - $kbits}] + } else { + # All 64 bits of output are used. + # Eight messages bytes are needed per iteration. + set msgBytes 8 + set xbits 0 + } + + # Store the result here + set result {} + set tempresult {} + + # Set up the initialization vector bitstream + binary scan $ivec H8H8 leftTemp rightTemp + set left "0x$leftTemp" + set right "0x$rightTemp" + #puts "Retrieved Feedback vector: $fbvec" + #puts "Start: |$left| |$right|" + + # Loop through each 64 bit chunk of the message + while {$m < $len} { + # puts "Left start: $left"; + # puts "Right start: $right"; + + # First each 64 but chunk of the + # message must be permuted according to IP. + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {(($right >> 2) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + + set left [expr {((($left << 1) & 0xffffffff) | \ + (($left >> 31) & 0x00000001))}]; + set right [expr {((($right << 1) & 0xffffffff) | \ + (($right >> 31) & 0x00000001))}]; + + #puts "Left IP: [format %x $left]"; + #puts "Right IP: [format %x $right]"; + + # Do this 1 time for each chunk of the message + set endloop [lindex $looping 1]; + set loopinc [lindex $looping 2]; + + # puts "endloop: $endloop"; + # puts "loopinc: $loopinc"; + + # Now go through and perform the encryption or decryption + for {set i [lindex $looping 0]} \ + {$i != $endloop} {incr i $loopinc} { + # For efficiency + set right1 [expr {$right ^ [lindex $keys $i]}]; + set right2 [expr {((($right >> 4) & 0x0fffffff) | \ + (($right << 28) & 0xffffffff)) ^ \ + [lindex $keys [expr {$i + 1}]]}]; + + # puts "right1: [format %x $right1]"; + # puts "right2: [format %x $right2]"; + + # The result is attained by passing these + # bytes through the S selection functions. + set temp $left; + set left $right; + set right [expr {$temp ^ ([lindex $spfunction2 [expr {($right1 >> 24) & 0x3f}]] | \ + [lindex $spfunction4 [expr {($right1 >> 16) & 0x3f}]] | \ + [lindex $spfunction6 [expr {($right1 >> 8) & 0x3f}]] | \ + [lindex $spfunction8 [expr {$right1 & 0x3f}]] | \ + [lindex $spfunction1 [expr {($right2 >> 24) & 0x3f}]] | \ + [lindex $spfunction3 [expr {($right2 >> 16) & 0x3f}]] | \ + [lindex $spfunction5 [expr {($right2 >> 8) & 0x3f}]] | \ + [lindex $spfunction7 [expr {$right2 & 0x3f}]])}]; + + # puts "Left iter: [format %x $left]"; + # puts "Right iter: [format %x $right]"; + } + set temp $left; + set left $right; + set right $temp; # Unreverse left and right + + #puts "Left Iterated: [format %x $left]"; + #puts "Right Iterated: [format %x $right]"; + + # Move then each one bit to the right + set left [expr {((($left >> 1) & 0x7fffffff) | \ + (($left << 31) & 0xffffffff))}]; + set right [expr {((($right >> 1) & 0x7fffffff) | \ + (($right << 31) & 0xffffffff))}]; + + #puts "Left shifted: [format %x $left]"; + #puts "Right shifted: [format %x $right]"; + + # Now perform IP-1, which is IP in the opposite direction + set temp [expr {((($left >> 1) & 0x7fffffff) ^ $right) & 0x55555555}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 1)}]; + set temp [expr {((($right >> 8) & 0x00ffffff) ^ $left) & 0x00ff00ff}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 8)}]; + set temp [expr {((($right >> 2) & 0x3fffffff) ^ $left) & 0x33333333}]; + set left [expr {$left ^ $temp}]; + set right [expr {$right ^ ($temp << 2)}]; + set temp [expr {((($left >> 16) & 0x0000ffff) ^ $right) & 0x0000ffff}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 16)}]; + set temp [expr {((($left >> 4) & 0x0fffffff) ^ $right) & 0x0f0f0f0f}]; + set right [expr {$right ^ $temp}]; + set left [expr {$left ^ ($temp << 4)}]; + + #puts "Left IP-1: [format %x $left]"; + #puts "Right IP-1: [format %x $right]"; + + # Extract the "kbits" most significant bits from the output block. + if {$kbits < 32} { + # Only some bits from left output are needed. + set kData [expr {($left >> $kOutShift) & $kOutMask}] + set newBits {} + # If necessary, copy message bytes into input bit cache. + if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { + if {$len - $n < $msgBytes} { + set lastBits [expr {($len - $n) * 8}] + ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] + binary scan $message x${n}B$lastBits newBits + } else { + # Extract "msgBytes" whole bytes as bits + ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] + binary scan $message x${n}B$msgBits newBits + } + incr n $msgBytes + #puts " $newBits $n [expr {$len - $n}]" + # Add the bits to the input bit cache. + append bitCacheIn $newBits + } + #puts -nonewline "In bit cache: $bitCacheIn" + # Set up message data from input bit cache. + binary scan [binary format B32 [format %032s [string range $bitCacheIn 0 $kbitsSub1]]] H8 temp + set msgData "0x$temp" + # Mix message bits with crypto bits. + set mixData [expr {$msgData ^ $kData}] + # Discard collected bits from the input bit cache. + set bitCacheIn [string range $bitCacheIn $kbits end] + #puts " After: $bitCacheIn" + # Convert back to a bit stream and append to the output bit cache. + # Only the lower kbits are wanted. + binary scan [binary format H8 [format %08x $mixData]] B32 msgOut + append bitCacheOut [string range $msgOut $xbits end] + #puts -nonewline "Out bit cache: $bitCacheOut" + # If there are sufficient bits, move bytes to the temporary holding string. + if {[string length $bitCacheOut] >= $msgBits} { + append tempresult [binary format B$msgBits [string range $bitCacheOut 0 $msgBitsSub1]] + set bitCacheOut [string range $bitCacheOut $msgBits end] + #puts -nonewline " After: $bitCacheOut" + incr m $msgBytes + ###puts "$m bytes output" + incr chunk $msgBytes + } + #puts "" + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set temp [expr {($right << $kbits) & 0xffffffff}] + set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] + set right [expr {$temp | $mixData}] + } else { + set temp [expr {($right << $kbits) & 0xffffffff}] + set left [expr {(($left << $kbits) & 0xffffffff) | (($right >> $kOutShift) & $kOutMask)}] + set right [expr {$temp | $msgData}] + } + } + } elseif {$kbits == 32} { + # Only bits of left output are used. + set kData $left + # Four messages bytes are needed per iteration. + binary scan $message x${m}H8 temp + incr m 4 + incr chunk 4 + set msgData "0x$temp" + # Mix message bits with crypto bits. + set mixData [expr {$msgData ^ $kData}] + # Move bytes to the temporary holding string. + append tempresult [binary format H8 [format %08x $mixData]] + # For CFB mode + if {$mode == 1} { + set left $right + if {$encrypt} { + set right $mixData + } else { + set right $msgData + } + } + } elseif {$kbits < 64} { + set kDataLeft [expr {($left >> $kOutShiftRight) & $kOutMaskRight}] + set temp [expr {($left << $kOutShiftLeft) & 0xffffffff}] + set kDataRight [expr {(($right >> $kOutShiftRight) & $kOutMaskRight) | $temp}] + # If necessary, copy message bytes into input bit cache. + if {([string length $bitCacheIn] < $kbits) && ($n < $len)} { + if {$len - $n < $msgBytes} { + set lastBits [expr {($len - $n) * 8}] + ###puts -nonewline [binary scan $message x${n}B$lastBits newBits] + binary scan $message x${n}B$lastBits newBits + } else { + # Extract "msgBytes" whole bytes as bits + ###puts -nonewline [binary scan $message x${n}B$msgBits newBits] + binary scan $message x${n}B$msgBits newBits + } + incr n $msgBytes + # Add the bits to the input bit cache. + append bitCacheIn $newBits + } + # Set up message data from input bit cache. + # puts "Bits from cache: [set temp [string range $bitCacheIn 0 $kbitsSub1]]" + # puts "Length of bit string: [string length $temp]" + binary scan [binary format B64 [format %064s [string range $bitCacheIn 0 $kbitsSub1]]] H8H8 leftTemp rightTemp + set msgDataLeft "0x$leftTemp" + set msgDataRight "0x$rightTemp" + # puts "msgDataLeft: $msgDataLeft" + # puts "msgDataRight: $msgDataRight" + # puts "kDataLeft: [format 0x%08x $kDataLeft]" + # puts "kDataRight: [format 0x%08x $kDataRight]" + # Mix message bits with crypto bits. + set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] + set mixDataRight [expr {$msgDataRight ^ $kDataRight}] + # puts "mixDataLeft: $mixDataLeft" + # puts "mixDataRight: $mixDataRight" + # puts "mixDataLeft: [format 0x%08x $mixDataLeft]" + # puts "mixDataRight: [format 0x%08x $mixDataRight]" + # Discard collected bits from the input bit cache. + set bitCacheIn [string range $bitCacheIn $kbits end] + # Convert back to a bit stream and + # append to the output bit cache. + # Only the lower kbits are wanted. + binary scan \ + [binary format H8H8 \ + [format %08x $mixDataLeft] \ + [format %08x $mixDataRight]] B64 msgOut + append bitCacheOut [string range $msgOut $xbits end] + # If there are sufficient bits, move + # bytes to the temporary holding string. + if {[string length $bitCacheOut] >= $msgBits} { + append tempresult \ + [binary format B$msgBits \ + [string range $bitCacheOut 0 $msgBitsSub1]] + set bitCacheOut [string range $bitCacheOut $msgBits end] + incr m $msgBytes + incr chunk $msgBytes + } + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set temp \ + [expr {($right << $kOutShiftRight) & 0xffffffff}] + set left [expr {$temp | $mixDataLeft}] + set right $mixDataRight + } else { + set temp \ + [expr {($right << $kOutShiftRight) & 0xffffffff}] + set left [expr {$temp | $msgDataLeft}] + set right $msgDataRight + } + } + } else { + # All 64 bits of output are used. + set kDataLeft $left + set kDataRight $right + # Eight messages bytes are needed per iteration. + binary scan $message x${m}H8H8 leftTemp rightTemp + incr m 8 + incr chunk 8 + set msgDataLeft "0x$leftTemp" + set msgDataRight "0x$rightTemp" + # Mix message bits with crypto bits. + set mixDataLeft [expr {$msgDataLeft ^ $kDataLeft}] + set mixDataRight [expr {$msgDataRight ^ $kDataRight}] + # Move bytes to the temporary holding string. + append tempresult \ + [binary format H16 \ + [format %08x%08x $mixDataLeft $mixDataRight]] + # For CFB mode + if {$mode == 1} { + if {$encrypt} { + set left $mixDataLeft + set right $mixDataRight + } else { + set left $msgDataLeft + set right $msgDataRight + } + } + } + + #puts "Left final: [format %08x $left]"; + #puts "Right final: [format %08x $right]" + + if {$chunk >= 512} { + append result $tempresult + set tempresult {}; + set chunk 0; + } + }; # For every 8 characters, or 64 bits in the message + #puts "End: |[format 0x%08x $left]| |[format 0x%08x $right]|" + # Save the left and right registers to the feedback vector. + set ivec [binary format H* [format %08x $left][format %08x $right]] + #puts "Saved Feedback vector: $fbvectors($fbvector)" + + append result $tempresult + if {[string length $result] > $len} { + set result [string replace $result $len end] + } + # Return the result as an array + return $result + }; # End of stream + + variable pc2bytes0 [list 0 0x4 0x20000000 0x20000004 0x10000 0x10004 0x20010000 0x20010004 0x200 0x204 0x20000200 0x20000204 0x10200 0x10204 0x20010200 0x20010204] + variable pc2bytes1 [list 0 0x1 0x100000 0x100001 0x4000000 0x4000001 0x4100000 0x4100001 0x100 0x101 0x100100 0x100101 0x4000100 0x4000101 0x4100100 0x4100101] + variable pc2bytes2 [list 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808 0 0x8 0x800 0x808 0x1000000 0x1000008 0x1000800 0x1000808] + variable pc2bytes3 [list 0 0x200000 0x8000000 0x8200000 0x2000 0x202000 0x8002000 0x8202000 0x20000 0x220000 0x8020000 0x8220000 0x22000 0x222000 0x8022000 0x8222000] + variable pc2bytes4 [list 0 0x40000 0x10 0x40010 0 0x40000 0x10 0x40010 0x1000 0x41000 0x1010 0x41010 0x1000 0x41000 0x1010 0x41010] + variable pc2bytes5 [list 0 0x400 0x20 0x420 0 0x400 0x20 0x420 0x2000000 0x2000400 0x2000020 0x2000420 0x2000000 0x2000400 0x2000020 0x2000420] + variable pc2bytes6 [list 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002 0 0x10000000 0x80000 0x10080000 0x2 0x10000002 0x80002 0x10080002] + variable pc2bytes7 [list 0 0x10000 0x800 0x10800 0x20000000 0x20010000 0x20000800 0x20010800 0x20000 0x30000 0x20800 0x30800 0x20020000 0x20030000 0x20020800 0x20030800] + variable pc2bytes8 [list 0 0x40000 0 0x40000 0x2 0x40002 0x2 0x40002 0x2000000 0x2040000 0x2000000 0x2040000 0x2000002 0x2040002 0x2000002 0x2040002] + variable pc2bytes9 [list 0 0x10000000 0x8 0x10000008 0 0x10000000 0x8 0x10000008 0x400 0x10000400 0x408 0x10000408 0x400 0x10000400 0x408 0x10000408] + variable pc2bytes10 [list 0 0x20 0 0x20 0x100000 0x100020 0x100000 0x100020 0x2000 0x2020 0x2000 0x2020 0x102000 0x102020 0x102000 0x102020] + variable pc2bytes11 [list 0 0x1000000 0x200 0x1000200 0x200000 0x1200000 0x200200 0x1200200 0x4000000 0x5000000 0x4000200 0x5000200 0x4200000 0x5200000 0x4200200 0x5200200] + variable pc2bytes12 [list 0 0x1000 0x8000000 0x8001000 0x80000 0x81000 0x8080000 0x8081000 0x10 0x1010 0x8000010 0x8001010 0x80010 0x81010 0x8080010 0x8081010] + variable pc2bytes13 [list 0 0x4 0x100 0x104 0 0x4 0x100 0x104 0x1 0x5 0x101 0x105 0x1 0x5 0x101 0x105] + + # Now define the left shifts which need to be done + variable shifts {0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0}; + + # Procedure: createKeys + # Input: + # key : The 64-bit DES key (Note: The lsb of each byte + # is ignored; odd parity is not required). + # + # weak: If true then weak keys are allowed. The default is to raise an + # error when a weak key is seen. + # Output: + # The 16 (DES) subkeys. + proc createKeys {key {weak 0}} { + variable pc2bytes0 + variable pc2bytes1 + variable pc2bytes2 + variable pc2bytes3 + variable pc2bytes4 + variable pc2bytes5 + variable pc2bytes6 + variable pc2bytes7 + variable pc2bytes8 + variable pc2bytes9 + variable pc2bytes10 + variable pc2bytes11 + variable pc2bytes12 + variable pc2bytes13 + variable shifts + + # Stores the return keys + set keys {} + # Other variables + set lefttemp {}; set righttemp {} + binary scan $key H8H8 lefttemp righttemp + set left {} + append left "0x" $lefttemp + set right {} + append right "0x" $righttemp + + #puts "Left key: $left" + #puts "Right key: $right" + + # Test for weak keys + if {! $weak} { + set maskedLeft [expr {$left & 0xfefefefe}] + set maskedRight [expr {$right & 0xfefefefe}] + if {($maskedLeft == 0x00000000) \ + && ($maskedRight == 0x00000000)} { + error "The key is weak!" + } elseif {($maskedLeft == 0x1e1e1e1e) \ + && ($maskedRight == 0x0e0e0e0e)} { + error "The key is weak!" + } elseif {($maskedLeft == 0xe0e0e0e0) \ + && ($maskedRight == 0xf0f0f0f0)} { + error "The key is weak!" + } elseif {($maskedLeft == 0xfefefefe) \ + && ($maskedRight == 0xfefefefe)} { + error "The key is weak!" + } + } + + set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 4)}] + set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 16)}] + set temp [expr {(($left >> 2) ^ $right) & 0x33333333}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 2)}] + set temp [expr {(($right >> 16) ^ $left) & 0x0000ffff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 16)}] + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] + set right [expr {$right ^ $temp}] + set left [expr {$left ^ ($temp << 1)}] + set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}] + set left [expr {$left ^ $temp}] + set right [expr {$right ^ ($temp << 8)}] + set temp [expr {(($left >> 1) ^ $right) & 0x55555555}] + set right [expr $right ^ $temp] + set left [expr {$left ^ ($temp << 1)}] + + # puts "Left key PC1: [format %x $left]" + # puts "Right key PC1: [format %x $right]" + + # The right side needs to be shifted and to get + # the last four bits of the left side + set temp [expr {($left << 8) | (($right >> 20) & 0x000000f0)}]; + # Left needs to be put upside down + set left [expr {($right << 24) | (($right << 8) & 0x00ff0000) | \ + (($right >> 8) & 0x0000ff00) \ + | (($right >> 24) & 0x000000f0)}]; + set right $temp; + + #puts "Left key juggle: [format %x $left]" + #puts "Right key juggle: [format %x $right]" + + # Now go through and perform these + # shifts on the left and right keys. + foreach i $shifts { + # Shift the keys either one or two bits to the left. + if {$i} { + set left [expr {($left << 2) \ + | (($left >> 26) & 0x0000003f)}]; + set right [expr {($right << 2) \ + | (($right >> 26) & 0x0000003f)}]; + } else { + set left [expr {($left << 1) \ + | (($left >> 27) & 0x0000001f)}]; + set right [expr {($right << 1) \ + | (($right >> 27) & 0x0000001f)}]; + } + set left [expr {$left & 0xfffffff0}]; + set right [expr {$right & 0xfffffff0}]; + + # Now apply PC-2, in such a way that E is easier when encrypting or + # decrypting this conversion will look like PC-2 except only the + # last 6 bits of each byte are used rather than 48 consecutive bits + # and the order of lines will be according to how the S selection + # functions will be applied: S2, S4, S6, S8, S1, S3, S5, S7. + set lefttemp [expr {[lindex $pc2bytes0 [expr {($left >> 28) & 0x0000000f}]] | \ + [lindex $pc2bytes1 [expr {($left >> 24) & 0x0000000f}]] | \ + [lindex $pc2bytes2 [expr {($left >> 20) & 0x0000000f}]] | \ + [lindex $pc2bytes3 [expr {($left >> 16) & 0x0000000f}]] | \ + [lindex $pc2bytes4 [expr {($left >> 12) & 0x0000000f}]] | \ + [lindex $pc2bytes5 [expr {($left >> 8) & 0x0000000f}]] | \ + [lindex $pc2bytes6 [expr {($left >> 4) & 0x0000000f}]]}]; + set righttemp [expr {[lindex $pc2bytes7 [expr {($right >> 28) & 0x0000000f}]] | \ + [lindex $pc2bytes8 [expr {($right >> 24) & 0x0000000f}]] | \ + [lindex $pc2bytes9 [expr {($right >> 20) & 0x0000000f}]] | \ + [lindex $pc2bytes10 [expr {($right >> 16) & 0x0000000f}]] | \ + [lindex $pc2bytes11 [expr {($right >> 12) & 0x0000000f}]] | \ + [lindex $pc2bytes12 [expr {($right >> 8) & 0x0000000f}]] | \ + [lindex $pc2bytes13 [expr {($right >> 4) & 0x0000000f}]]}]; + set temp [expr {(($righttemp >> 16) ^ $lefttemp) & 0x0000ffff}]; + lappend keys [expr {$lefttemp ^ $temp}]; + lappend keys [expr {$righttemp ^ ($temp << 16)}]; + } + # Return the keys we've created. + return $keys; + }; # End of createKeys. +}; # End of des namespace eval. + +package provide tclDESjr 1.0.0 |