to see a pure-Tcl implementation of a DES (just 56-bit encryption) go [http://loewerj.freeshell.org/des.tcl].

Read about DES in the Handbook of Applied Cryptography [http://www.cacr.math.uwaterloo.ca/hac/] Chapter 7 [http://www.cacr.math.uwaterloo.ca/hac/about/chap7.pdf]

This can/should go into the tcllib.

to encrypt do:
  package require des
  DES::GetKey -encrypt <password> encryptKeysArray
  # or DES::GetKey -encryptVNC <password> encryptKeysArray
  set encryptedBlock [DES::DoBlock <PlainText8ByteBlock> encryptKeysArray]
  ...

to decrypt do:
  package require des
  DES::GetKey -decrypt <password> decryptKeysArray 
  set plainText [DES::DoBlock <Encrypted8ByteBlock> decryptKeysArray]
  ...


I did a pure-tcl implementation of Eric Young's fast version some years ago. The recent developement of [TkVNC] (pure-Tcl as well) and the missing authentication, leads me to release the code. Unfortunately, I recognize that the [VNC] implementation generates the
key vector out of the key/password slightly different. So I reimplemented another, more
readable version, whichs allows standard and VNC mode easily to be switched.
I still have the old version around.

[Jochen Loewer]

----

[PT] writes:
This would be a fine addition to [tcllib] although to add this we need a file of tests to ensure that it is working correctly. I gave this a try and for Tcl 8.4.1 on Win98 I unfortunately get
   DES::GetKey -encrypt sekret K
   set e [DES::DesBlock "01234567" K]
   integer value too large to represent
The error comes from the ''binary format I* ...''

[Jochen Loewer]: your example works for me in Tcl8.0 and Tcl8.3. Do you have a 64bit Tcl8.4? Need to read the 8.4 man pages for 'binary'.
[Jochen Loewer]: it works now. Basically upon return, values must be force to be 32bit values ( & 0xffffffff). Download newest version to test it.
----

[Pascal Scheffers]: Nice work! Before adding this to tcllib, though, it would be reasonably important to not only provide methods for ECB, but also for CBC, CFB and OFB. As these last are the ones actually used by most protocols. And while you're at it maybe 2-key 3des. EBC is very interesting for academic purposes, but should be avoided if possible - if only this ends up in tcllib a lot of people will have a Warm, Fuzzy, ''False'' Sense of Security when they start using ECB encryption. Normal users should have a higher level interface. 

   package require des
   DES::GetKey -encrypt <password> encryptKeysArray
   set myPlainText {An arbitrary amount of text you would normally use}
   set myCipherText [DES::DoOFB $myPlainText encryptKeysArray]

Have you run the code against a DES test set?   

[PS] adds - I have started a description of [block cipher modes] for those interested. And for DES specifically FIPS 81 [http://www.itl.nist.gov/fipspubs/fip81.htm]

----

[PT] writes: [aku] posted me his Trfcrypt des test file and I have modified this into a tcllib style test suite. I also added a wrapper proc so it looks a bit like the other packages in tcllib. That is:
   set cryptotext [DES::des -mode encode -key $secret $plaintext]
   set plaintext [DES::des -mode decode -key $secret $cryptotext]
Using this function it passes the tests so - provided it gets some documentation this can go into tcllib. Perhaps it should wait until one of the other cipher modes has been added in though. I can see why ECB isn't suitable as you can get it to produce repeating blocks given homogenous input.

The extra procs:

 # -------------------------------------------------------------------------
 # Description:
 #  Pop the nth element off a list. Used in options processing.
 #
 proc DES::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
 }

 # -------------------------------------------------------------------------

 proc DES::des {args} {
    array set opts [list filename {} mode {encode} key {I love Tcl!}]
    while {[string match -* [lindex $args 0]]} {
        switch -glob -- [lindex $args 0] {
            -f* {set opts(filename) [Pop args 1]}
            -m* {set opts(mode) [Pop args 1]}
            -k* {set opts(key) [Pop args 1]}
            --   {Pop args ; break }
            default {
                set err [join [lsort [array names opts]] ", -"]
                return -code error "bad option [lindex $args 0]:\
                       must be one of -$options"
            }
        }
        Pop args
    }

    # Build the key
    switch -exact -- $opts(mode) {
        encode { GetKey -encrypt $opts(key) key }
        decode { GetKey -decrypt $opts(key) key }
        default {
            return -code error "bad option \"$opts(mode)\": \
                   must be either \"encode\" or \"decode\""
        }
    }

    set r {}
    if {$opts(filename) != {}} {
        set f [open $opts(filename) r]
        fconfigure $f -translation binary
        while {![eof $f]} {
            set d [read $f 8]
            if {[set n [string length $d]] < 8} {
                append d [string repeat \0 [expr {8 - $n}]]
            }
            append r [DesBlock $d key]
        }
        close $f
    } else {
        set data [lindex $args 0]
        if {[set n [expr {[string length $data] % 8}]] != 0} {
            append data [string repeat \0 [expr {8 - $n}]]
        }
        for {set n 0} {$n < [string length $data]} {incr n 8} {
            append r [DesBlock [string range $data $n [expr {$n + 7}]] key]
        }
    }

    return $r
 }

----

The test file:

 # -*- 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: 8196,v 1.23 2003-01-24 09:01:49 jcw Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import ::tcltest::*
 }
 
 package require des
 
 # -------------------------------------------------------------------------
 
 catch {unset in out key}
 
 array set key {
     1	0000000000000000
     2	FFFFFFFFFFFFFFFF
     3	3000000000000000
     4	1111111111111111
     5	0123456789ABCDEF
     6	1111111111111111
     7	0000000000000000
     8	FEDCBA9876543210
     9	7CA110454A1A6E57
     10	0131D9619DC1376E
     11	07A1133E4A0B2686
     12	3849674C2602319E
     13	04B915BA43FEB5B6
     14	0113B970FD34F2CE
     15	0170F175468FB5E6
     16	43297FAD38E373FE
     17	07A7137045DA2A16
     18	04689104C2FD3B2F
     19	37D06BB516CB7546
     20	1F08260D1AC2465E
     21	584023641ABA6176
     22	025816164629B007
     23	49793EBC79B3258F
     24	4FB05E1515AB73A7
     25	49E95D6D4CA229BF
     26	018310DC409B26D6
     27	1C587F1C13924FEF
     28	0101010101010101
     29	1F1F1F1F0E0E0E0E
     30	E0FEE0FEF1FEF1FE
     31	0000000000000000
     32	FFFFFFFFFFFFFFFF
     33	0123456789ABCDEF
     34	FEDCBA9876543210
 }
 
 array set in {
     1	0000000000000000
     2	FFFFFFFFFFFFFFFF
     3	1000000000000001
     4	1111111111111111
     5	1111111111111111
     6	0123456789ABCDEF
     7	0000000000000000
     8	0123456789ABCDEF
     9	01A1D6D039776742
     10	5CD54CA83DEF57DA
     11	0248D43806F67172
     12	51454B582DDF440A
     13	42FD443059577FA2
     14	059B5E0851CF143A
     15	0756D8E0774761D2
     16	762514B829BF486A
     17	3BDD119049372802
     18	26955F6835AF609A
     19	164D5E404F275232
     20	6B056E18759F5CCA
     21	004BD6EF09176062
     22	480D39006EE762F2
     23	437540C8698F3CFA
     24	072D43A077075292
     25	02FE55778117F12A
     26	1D9D5C5018F728C2
     27	305532286D6F295A
     28	0123456789ABCDEF
     29	0123456789ABCDEF
     30	0123456789ABCDEF
     31	FFFFFFFFFFFFFFFF
     32	0000000000000000
     33	0000000000000000
     34	FFFFFFFFFFFFFFFF
 }
 
 array set out {
     1	8CA64DE9C1B123A7
     2	7359B2163E4EDC58
     3	958E6E627A05557B
     4	F40379AB9E0EC533
     5	17668DFC7292532D
     6	8A5AE1F81AB8F2DD
     7	8CA64DE9C1B123A7
     8	ED39D950FA74BCC4
     9	690F5B0D9A26939B
     10	7A389D10354BD271
     11	868EBB51CAB4599A
     12	7178876E01F19B2A
     13	AF37FB421F8C4095
     14	86A560F10EC6D85B
     15	0CD3DA020021DC09
     16	EA676B2CB7DB2B7A
     17	DFD64A815CAF1A0F
     18	5C513C9C4886C088
     19	0A2AEEAE3FF4AB77
     20	EF1BF03E5DFA575A
     21	88BF0DB6D70DEE56
     22	A1F9915541020B56
     23	6FBF1CAFCFFD0556
     24	2F22E49BAB7CA1AC
     25	5A6B612CC26CCE4A
     26	5F4C038ED12B2E41
     27	63FAC0D034D9F793
     28	617B3A0CE8F07100
     29	DB958605F8C8C606
     30	EDBFD1C66C29CCC7
     31	355550B2150E2451
     32	CAAAAF4DEAF1DBAE
     33	D5D44FF720683D0D
     34	2A2BB008DF97C2F2
 }
 
 
 foreach i [lsort [array names key]] {
     test des-1.$i {des encryption (ECB)} {
         set k [binary format H* $key($i)]
         set p [binary format H* $in($i)]
         set s [DES::des -mode encode -key $k $p]
         binary scan $s H* h
         string toupper $h
     } $out($i)
 }
 
 foreach i [lsort [array names key]] {
     test des-2.$i {des decryption (ECB)} {
         set k [binary format H* $key($i)]
         set p [binary format H* $out($i)]
         set s [DES::des -mode decode -key $k $p]
         binary scan $s H* h
         string toupper $h
     } $in($i)
 }
 
 # -------------------------------------------------------------------------
 
 #catch {unset in out key}
 ::tcltest::cleanupTests
 
 # Local Variables:
 #  mode: tcl
 #  indent-tabs-mode: nil
 # End:

----
'''Weak Keys'''

The highlevel methods should prevent the use of these weak keys (throw an error?). Low level methods should not have this restriction. 

Keys which considered weak are:

   * 0000000 0000000
   * 0000000 FFFFFFF
   * FFFFFFF 0000000
   * FFFFFFF FFFFFFF

Some pairs of keys encrypt plaintext to identical ciphertext. These semi weak keys are:

   * 01FE01FE01FE01FE and FE01FE01FE01FE01
   * 1FE01FE00EF10EF1 and E01FE01FF10EF10E
   * 01E001E001F101F1 and E001E001F101F101
   * 1FFE1FFE0EFE0EFE and FE1FFE1FFE0EFE0E
   * 011F011F010E010E and 1F011F010E010E01
   * E0FEE0FEF1FEF1FE and FEE0FEE0FEF1FEF1

There are also 48 keys which produce only four distinct subkeys (instead of 16) - these are called possibly weak keys. We can safely ignore these.

----
'''Performance'''

A simple benchmark, testing encryption+decryption of 100.000 bytes:

 package require des

 set k [binary format H* 86A560F10EC6D85B]
 #make a 100.000 bytes long msg:
 for { set x 0 } { $x < 10000 } {incr x } {
    append msg "1234567890"
 }

 puts "Size: [string length $msg]"
 puts [time {
   set c [DES::des -mode encode -key $k $msg]
   set p [DES::des -mode decode -key $k $c]
 } 1]

Results:

 Tcl 8.4.1 
 Pentium IV 1800Mhz:  8.3 seconds (linux, ActiveTcl)
 Pentium III 930Mhz:  35 seconds (linux, ActiveTcl)

 Tcl 8.3.4
 Pentium III 930Mhz:  27 seconds (linux, redhat)
 AMD K6-400Mhz: 52 seconds (linux, redhat)

23jan03 [jcw] - Here's an example of the "Ghz trap":

 Both based on Tcl 8.4.1 (Tclkit Nov 2002):
 Pentium IV 2400Mhz: 6.2 seconds (linux)
 PowerPC G4 1000Mhz: 10.8 seconds (macosx)

----

[Mac Cody]: Having been summarily thrust into the "me too" catagory, I'll let you know I'm about to release a pure-Tcl implementation of DES as well.  TclDES performs both DES and 3DES (triple-DES) encryption/decryption.  It supports both Electronic Code Block (ECB) and Cipher Block Chaining (CBC)* modes of operation.  I would have released it back last year, but time and other commitments have prevented me from doing so.  Right now, I'm trying to get an opinion from the U.S. Bureau of Industry and Security on whether I can get an export license exception TSU (Technology and software unrestricted).  The Export Administration Regulations (EAR) and the Wassenaar Agreements are not 100% clear on releasing 3DES. I also have a version of the code, with the 3DES capabilities stripped out, called TclDESjr. It can be freely circulated. - updated January 23, 2003.

*Corrected from Cyclical Block Chaining, thanks to [AK]! I should have got that right. Sort of tired that evening.

[AK]: Nice. Nit-pick. CBC = Cipher Block Chaining. The last two modes are CFB and OFB = Cipher/Output FeedBack.

----

[[ [Category Package] | [Category Cryptography] ]]