Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

7 files changed, 1194 insertions, 0 deletions

diff --git a/tcllib/modules/rc4/ChangeLog b/tcllib/modules/rc4/ChangeLog
new file mode 100644
index 0000000..f140cdf
--- /dev/null
+++ b/tcllib/modules/rc4/ChangeLog
@@ -0,0 +1,134 @@
+2013-02-08  Andreas Kupries  <andreask@activestate.com>
+
+	* rc4.man: fixed bogus trailing comma in list of keywords.
+
+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 ========================
+	* 
+
+2009-05-07  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4c.tcl: Fixed an object leak in the critcl implementation
+
+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-03-21  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* rc4.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-29  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* rc4.test: Fixed use and cleanup of temp. files
+
+2006-01-23  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* rc4.test: More boilerplate simplified via use of test support.
+
+2006-01-19  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* rc4.test: Hooked into the new common test support code.
+
+2005-12-20  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4.tcl:   Dealt with bug #1386101 (rc4 critcl + channels broken)
+	* rc4.test:  Also implemented a -command option. Added tests for
+	* rc4.man:   both and update man page for -command.
+	* pkgIndex.tcl: Incremented version to 1.1.0
+
+2005-10-18  Andreas Kupries <andreask@activestate.com>
+
+	* rc4.bench: Extended with benchmarks for the keyschedule.
+
+2005-10-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.8 ========================
+	* 
+
+2005-10-05  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4c.tcl: Fixed to permit compilation with msvc and gcc.
+
+2005-09-04  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4.tcl:  Frink error suppression.
+	* rc4.man:  Added documentation for the programming api.
+
+2005-02-20  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4.tcl: Ensure all implementations available are tested. Added
+	* rc4.man: improved hypen handling. '--' is an optional end-of-options
+	* pkgIndex.tcl:	marker.
+
+2004-10-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.7 ========================
+	* 
+
+2004-07-29  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* rc4.test: Fixed x-version problems of the testsuite. The tests
+	  wrongly used the tcltest::wrongNumArgs command. In this case the
+	  error message is generated by the proc code and the same across
+	  all versions of Tcl.
+
+2004-07-04  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4.test: Added basic command tests.
+	* rc4c.tcl: Critcl implementation.
+	* rc4.tcl:  Support critcl implementation.
+
+	* rc4.tcl:  Storing the state as a list and using lset is faster
+	than using an array provided we have a built-in lset
+	command. Added both versions and switch appropriately to get the
+	fastest implementation for the tcl version. Tested 8.2 - 8.5.
+
+2004-07-01  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* rc4.tcl:  Pure tcl implementation of the Alledged RC4 stream cipher.
+	* rc4.test: Some published test vectors for RC4.
+	* rc4.man:  Documentation.
diff --git a/tcllib/modules/rc4/pkgIndex.tcl b/tcllib/modules/rc4/pkgIndex.tcl
new file mode 100644
index 0000000..84a5d47
--- /dev/null
+++ b/tcllib/modules/rc4/pkgIndex.tcl
@@ -0,0 +1,13 @@
+# pkgIndex.tcl - 
+#
+# RC4 package index file
+#
+# This package has been tested with tcl 8.2.3 and above.
+#
+# $Id: pkgIndex.tcl,v 1.4 2005/12/20 16:19:38 patthoyts Exp $
+
+if {![package vsatisfies [package provide Tcl] 8.2]} {
+    # PRAGMA: returnok
+    return
+}
+package ifneeded rc4 1.1.0 [list source [file join $dir rc4.tcl]]
diff --git a/tcllib/modules/rc4/rc4.bench b/tcllib/modules/rc4/rc4.bench
new file mode 100644
index 0000000..ba3e3c8
--- /dev/null
+++ b/tcllib/modules/rc4/rc4.bench
@@ -0,0 +1,64 @@
+# -*- tcl -*-
+# Tcl Benchmark File
+#
+# This file contains a number of benchmarks for the 'rc4' 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 ...
+
+set moddir [file dirname [file dirname [info script]]]
+lappend auto_path $moddir
+
+package forget rc4
+catch {namespace delete ::rc4}
+source [file join [file dirname [info script]] rc4.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 "RC4 encryption" -body {
+    rc4::rc4 -key $k $p
+}
+
+bench -desc "RC4 decryption" -body {
+    rc4::rc4 -key $k $c
+}
+
+bench -desc "RC4 encryption core" -pre {
+    set key [rc4::RC4Init $k]
+} -body {
+    rc4::RC4 $key $p
+} -post {
+    rc4::RC4Final $key
+}
+
+bench -desc "RC4 decryption core" -pre {
+    set key [rc4::RC4Init $k]
+} -body {
+    rc4::RC4 $key $c
+} -post {
+    rc4::RC4Final $key
+}
+
+bench -desc "RC4 keyschedule" -body {
+    rc4::RC4Final [rc4::RC4Init $k]
+}
+
+# ### ### ### ######### ######### ######### ###########################
+## Complete
diff --git a/tcllib/modules/rc4/rc4.man b/tcllib/modules/rc4/rc4.man
new file mode 100644
index 0000000..d257772
--- /dev/null
+++ b/tcllib/modules/rc4/rc4.man
@@ -0,0 +1,120 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin rc4 n 1.1.0]
+[see_also aes(n)]
+[see_also blowfish(n)]
+[see_also des(n)]
+[keywords arcfour]
+[keywords {data integrity}]
+[keywords encryption]
+[keywords rc4]
+[keywords security]
+[keywords {stream cipher}]
+[copyright {2003, Pat Thoyts <patthoyts@users.sourceforge.net>}]
+[moddesc   {RC4 Stream Cipher}]
+[titledesc {Implementation of the RC4 stream cipher}]
+[category  {Hashes, checksums, and encryption}]
+[require Tcl 8.2]
+[require rc4 [opt 1.1.0]]
+[description]
+[para]
+
+This package is an implementation in Tcl of the RC4 stream cipher
+developed by Ron Rivest of RSA Data Security Inc. The cipher was a
+trade secret of RSA but was reverse-engineered and published to the
+internet in 1994. It is used in a number of network protocols for
+securing communications. To evade trademark restrictions this cipher
+is sometimes known as ARCFOUR.
+
+[section {COMMANDS}]
+
+[list_begin definitions]
+
+[call [cmd "::rc4::rc4"] \
+     [opt "[arg -hex]"] \
+     [arg "-key keyvalue" ] \
+     [opt [arg "-command lst"]] \
+     [opt [arg "-out channel"]] \
+     [lb] [arg "-in channel"] | \
+     [arg "-infile filename"] | [arg "string"] [rb]]
+
+Perform the RC4 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.
+Giving the [arg "-hex"] option will return a hexadecimal encoded
+version of the result if not using an [arg -out] channel.
+
+[para]
+
+The data to be processes can be specified either as a string argument to
+the rc4 command, or as a filename or a pre-opened channel. If the
+[arg "-infile"] argument is given then the file is opened, the data read
+and processed and the file is closed. If the [arg "-in"] argument is
+given then data is read from the channel until the end of file. The
+channel is not closed. If the [arg "-out"] argument is given then the
+processing result is written to this channel.
+
+[para]
+
+If [arg "-command"] is provided then the rc4 command does not return
+anything. Instead the command provided is called with the rc4 result data
+appended as the final parameter. This is most useful when reading from Tcl
+channels as a fileevent is setup on the channel and the data processed in
+chunks
+
+[para]
+
+Only one of [arg "-infile"], [arg "-in"] or [arg "string"] should be given.
+
+[list_end]
+
+[section "PROGRAMMING INTERFACE"]
+
+[list_begin definitions]
+
+[call [cmd "::rc4::RC4Init"] [arg "keydata"]]
+
+Initialize a new RC4 key. The [arg keydata] is any amount of binary
+data and is used to initialize the cipher internal state.
+
+[call [cmd "::rc4::RC4"] [arg "Key"] [arg "data"]]
+
+Encrypt or decrypt the input data using the key obtained by calling
+[cmd RC4Init].
+
+[call [cmd "::rc4::RC4Final"] [arg "Key"]]
+
+This should be called to clean up resources associated with
+[arg Key]. Once this function has been called the key is destroyed.
+
+[list_end]
+
+[section "EXAMPLES"]
+
+[example {
+% set keydata [binary format H* 0123456789abcdef]
+% rc4::rc4 -hex -key $keydata HelloWorld
+3cf1ae8b7f1c670b612f
+% rc4::rc4 -hex -key $keydata [binary format H* 3cf1ae8b7f1c670b612f]
+HelloWorld
+}]
+
+[example {
+ set Key [rc4::RC4Init "key data"]
+ append ciphertext [rc4::RC4 $Key $plaintext]
+ append ciphertext [rc4::RC4 $Key $additional_plaintext]
+ rc4::RC4Final $Key
+}]
+
+[example {
+ proc ::Finish {myState data} {
+     DoStuffWith $myState $data
+ }
+ rc4::rc4 -in $socket -command [list ::Finish $ApplicationState]
+}]
+
+[section "AUTHORS"]
+Pat Thoyts
+
+[vset CATEGORY rc4]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/rc4/rc4.tcl b/tcllib/modules/rc4/rc4.tcl
new file mode 100644
index 0000000..37b4a12
--- /dev/null
+++ b/tcllib/modules/rc4/rc4.tcl
@@ -0,0 +1,422 @@
+# rc4.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# RC4 is a symmetric stream cipher developed by Ron Rivest of RSA Data
+# Security Inc. The algorithm was a trade secret of RSA but was reverse
+# engineered and published to the internet in 1994. This pure Tcl
+# implementation is based on the description of the algorithm.
+#
+# The algorithm is a pseudo-random number generator with the output of
+# the PRNG being xored with the plaintext stream. Decryption is done
+# by feeding the ciphertext as input with the same key.
+
+package require Tcl 8.2
+
+# @mdgen EXCLUDE: rc4c.tcl
+
+namespace eval ::rc4 {
+    namespace export rc4
+
+    variable uid
+    if {![info exists uid]} {
+        set uid 0
+    }
+}
+
+# RC4Init - create and initialize the RC4 state as an array
+#
+proc ::rc4::RC4Init_Array {keystr} {
+    variable uid
+
+    binary scan $keystr c* key
+    set keylen [llength $key]
+
+    set Key [namespace current]::key[incr uid]
+    # FRINK: nocheck
+    variable $Key
+    upvar #0 $Key state
+    catch {unset state}
+
+    set state(x) 0
+    set state(y) 0
+    for {set cn 0} {$cn < 256} {incr cn} {
+        set state(s,$cn) $cn
+    }
+    set i 0
+    set j 0
+    for {set cn 0} {$cn < 256} {incr cn} {
+        set j [expr {([lindex $key $i] + $state(s,$cn) + $j) % 256}]
+        set t $state(s,$cn)
+        set state(s,$cn) $state(s,$j)
+        set state(s,$j) $t
+        set i [expr {($i + 1) % $keylen}]
+    }
+
+    return $Key
+}
+
+# RC4 - process the data using the array based state
+#
+proc ::rc4::RC4_Array {Key datastr} {
+    upvar #0 $Key state
+    set res {}
+
+    binary scan $datastr c* data
+    set datalen [llength $data]
+    
+    set x $state(x)
+    set y $state(y)
+
+    for {set cn 0} {$cn < $datalen} {incr cn} {
+        set x [expr {($x + 1) % 256}]
+        set y [expr {($state(s,$x) + $y) % 256}]
+        set t $state(s,$y)
+        set state(s,$y) $state(s,$x)
+        set state(s,$x) $t
+        set i [expr {($state(s,$x) + $state(s,$y)) % 256}]
+        lappend res [expr {([lindex $data $cn] ^ $state(s,$i)) & 0xFF}]
+    }
+    set state(x) $x
+    set state(y) $y
+    return [binary format c* $res]
+}
+
+# RC4Init - create and initialize the RC4 state as a list.
+#
+proc ::rc4::RC4Init_List {keystr} {
+    variable uid
+
+    binary scan $keystr c* key
+    set keylen [llength $key]
+
+    set Key [namespace current]::key[incr uid]
+    # FRINK: nocheck
+    variable $Key
+    upvar #0 $Key State
+    catch {unset State}
+
+    set i 0
+    set j 0
+    set s {}; #[::struct::list::Liota 256]
+    for {set n 0} {$n < 256} {incr n} {lappend s $n}
+    
+    for {set cn 0} {$cn < 256} {incr cn} {
+        set j [expr {([lindex $key $i] + [lindex $s $cn] + $j) % 256}]
+        set t [lindex $s $cn]
+        lset s $cn [lindex $s $j]
+        lset s $j $t
+        set i [expr {($i + 1) % $keylen}]
+    }
+    
+    set State(x) 0
+    set State(y) 0
+    set State(s) $s
+
+    return $Key
+}
+
+# RC4 - process the data using the list-based state.
+#
+proc ::rc4::RC4_List {Key datastr} {
+    upvar #0 $Key State
+    set res {}
+
+    binary scan $datastr c* data
+    set datalen [llength $data]
+    
+    set x $State(x)
+    set y $State(y)
+    set s $State(s)
+
+    for {set cn 0} {$cn < $datalen} {incr cn} {
+        set x [expr {($x + 1) % 256}]
+        set y [expr {([lindex $s $x] + $y) % 256}]
+        set t [lindex $s $y]
+        lset s $y [lindex $s $x]
+        lset s $x $t
+        set i [expr {([lindex $s $x] + [lindex $s $y]) % 256}]
+        lappend res [expr {([lindex $data $cn] ^ [lindex $s $i]) & 0xFF}]
+    }
+    set State(x) $x
+    set State(y) $y
+    set State(s) $s
+    return [binary format c* $res]
+}
+
+# PRAGMA: nocheck
+proc ::rc4::K {x y} {set x}
+
+# Using this compat function for < 8.4 is 2x slower than using arrays.
+if {[package vcompare [package provide Tcl] 8.4] < 0} {
+    proc ::rc4::lset {var index arg} {
+        upvar 1 $var list
+        set list [::lreplace [K $list [set list {}]] $index $index $arg]
+    }
+}
+
+proc ::rc4::RC4Final {Key} {
+    upvar #0 $Key state
+    catch {unset state}
+    return {}
+}
+
+# -------------------------------------------------------------------------
+# Helper to turn binary data into hex format.
+#
+proc ::rc4::Hex {data} {
+    binary scan $data H* result
+    return $result
+}
+
+# Demo function for use with Trf transform command to add automatic
+# RC4 encryption to a channel. Illustrates use of [transform]
+#
+# For instance, to create a file with all ondisk data encrypted:
+#   set f [open secretfile r+]
+#   transform -attach $f -command [list rc4::Transform $f Secret]
+#   puts -nonewline $f yourdata   ;# write to encrypt
+#   read $f                       ;# read to decrypt
+#   close $f
+#
+proc ::rc4::Transform {channel keystr operation data} {
+    set readkey [namespace current]::R$channel
+    # FRINK: nocheck
+    variable $readkey
+    upvar #0 $readkey rk
+    set writekey [namespace current]::W$channel
+    # FRINK: nocheck
+    variable $writekey
+    upvar #0 $writekey wk
+    set result {}
+
+    #puts stderr "$operation {$data}"
+    switch -- $operation {
+        create/write {
+            if {[info exists wk]} {
+                RCFinal $wk
+            }
+            set wk [RC4Init $keystr] 
+        }
+        clear/write {}
+        delete/write {
+            if {[info exists wk]} {
+                RC4Final $wk
+                unset wk
+            }
+        }
+        write - flush/write {
+            if {![info exists wk]} {
+                set wk [RC4Init $keystr]
+            }
+            set result [RC4 $wk $data] 
+        }
+
+        create/read {
+            if {[info exists rk]} {
+                RCFinal $rk
+            }
+            set rk [RC4Init $keystr] 
+        }
+        clear/read {}
+        delete/read {
+            if {[info exists rk]} {
+                RC4Final $rk
+                unset rk
+            }
+        }
+        read - flush/read {
+            if {![info exists rk]} {
+                set rk [RC4Init $keystr]
+            }
+            set result [RC4 $rk $data] 
+        }
+        
+        query/ratio {
+            set result {1 1};           # RC4 is a 1:1 stream cipher.
+        }
+        query/maxRead {
+            set result -1;              # Permit read of any amount
+        }
+        default {
+            # ignore unknown operations.
+        }
+    }
+    return $result
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Pop the nth element off a list. Used in options processing.
+#
+proc ::rc4::Pop {varname {nth 0}} {
+    upvar $varname args
+    set r [lindex $args $nth]
+    set args [lreplace $args $nth $nth]
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# Fileevent handler for chunked file hashing.
+#
+proc ::rc4::Chunk {State} {
+    upvar #0 $State state
+    
+    if {[eof $state(-in)]} {
+        fileevent $state(-in) readable {}
+        set state(reading) 0
+    }
+    set data [read $state(-in) $state(-chunksize)]
+    if {[llength $state(-out)] == 0} {
+        append state(output) [RC4 $state(Key) $data]
+    } else {
+        puts -nonewline $state(-out) [RC4 $state(Key) $data]
+    }
+    if {!$state(reading) && [llength $state(-command)] != 0} {
+        Cleanup $State; # cleanup and call users command 
+    }
+}
+
+
+proc ::rc4::Cleanup {State} {
+    upvar #0 $State state
+    set cmd $state(-command)
+    set res $state(output)
+    # If we opened the channel then we should close it too.
+    if {[string length $state(-infile)] > 0} {
+        close $state(-in)
+    }
+    RC4Final $state(Key)
+    unset state
+    if {[llength $cmd] != 0} {
+        eval $cmd [list $res]
+    }
+    return $res
+}
+
+# -------------------------------------------------------------------------
+
+proc ::rc4::rc4 {args} {
+    array set opts {-hex 0 -infile {} -in {} -out {} -chunksize 4096
+        -key {} -command {}}
+    while {[string match -* [set option [lindex $args 0]]]} {
+        switch -exact -- $option {
+            -key        { set opts(-key) [Pop args 1] }
+            -hex        { set opts(-hex) 1}
+            -infile     { set opts(-infile) [Pop args 1] }
+            -in         { set opts(-in) [Pop args 1] }
+            -out        { set opts(-out) [Pop args 1] }
+            -chunksize  { set opts(-chunksize) [Pop args 1] }
+            -command    { set opts(-command) [Pop args 1] }
+            default {
+                if {[llength $args] == 1} { break }
+                if {[string compare $option "--"] == 0} { Pop args; break }
+                set err [join [lsort [array names opts]] ", "]
+                return -code error "bad option $option:\
+                    must be one of $err"
+            }
+        }
+        Pop args
+    }
+
+    if {[string length $opts(-key)] < 1} {
+        return -code error "wrong # args:\
+            should be \"rc4 ?-hex? -key key -in channel | string\""
+    }
+
+    if {$opts(-infile) != {}} {
+        set opts(-in) [open $opts(-infile) r]
+        fconfigure $opts(-in) -translation binary
+    }
+
+    set r {}
+    if {$opts(-in) == {}} {
+        if {[llength $args] != 1} {
+            return -code error "wrong # args:\
+                should be \"rc4 ?-hex? -key key -in channel | string\""
+        }
+
+        set Key [RC4Init $opts(-key)]
+        set r [RC4 $Key [lindex $args 0]]
+        if {[llength $opts(-command)] != 0} {
+            eval $opts(-command) [list $r]
+            set r {}
+        } elseif {$opts(-out) != {}} {
+            puts -nonewline $opts(-out) $r
+            set r {}
+        }
+        RC4Final $Key
+
+    } else {
+
+        variable uid
+        set State [namespace current]::state[incr uid]
+        upvar #0 $State state
+        array set state [array get opts]
+        set state(Key) [RC4Init $opts(-key)]
+        set state(reading) 1
+        set state(output) ""
+        fileevent $opts(-in) readable [list [namespace origin Chunk] $State]
+        if {[llength $opts(-command)] != 0} {
+            return {}
+        } else {
+            vwait [set State](reading)
+            set r [Cleanup $State]
+        }
+    }
+
+    if {$opts(-hex)} {
+        set r [Hex $r]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+
+proc ::rc4::SelectImplementation {impl} {
+    switch -exact -- $impl {
+        critcl {
+            interp alias {} ::rc4::RC4Init {} ::rc4::rc4c_init
+            interp alias {} ::rc4::RC4     {} ::rc4::rc4c
+        }
+        array {
+            interp alias {} ::rc4::RC4Init {} ::rc4::RC4Init_Array
+            interp alias {} ::rc4::RC4     {} ::rc4::RC4_Array
+        }
+        list {
+            interp alias {} ::rc4::RC4Init {} ::rc4::RC4Init_List
+            interp alias {} ::rc4::RC4     {} ::rc4::RC4_List
+        }
+        default {
+            return -code error "invalid implementation \"$impl\":\
+                must be one of \"critcl\", \"array\" or \"list\""
+        }
+    }
+}
+
+# -------------------------------------------------------------------------
+
+# Using a list to hold the keystream state is a lot faster than using
+# an array. However, for Tcl < 8.4 we don't have the lset command.
+# Using a compatability lset is slower than using arrays.
+# Obviously, a compiled C version is fastest of all.
+# So lets pick the fastest method we can find...
+#
+namespace eval ::rc4 {
+    if {[catch {package require tcllibc}]} {
+        catch {package require rc4c}
+    }
+    if {[info commands ::rc4::rc4c] != {}} {
+        SelectImplementation critcl
+    } elseif {[package vcompare [package provide Tcl] 8.4] < 0} {
+        SelectImplementation array
+    } else {
+        SelectImplementation list
+    }
+}
+
+package provide rc4 1.1.0
+
+# -------------------------------------------------------------------------
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
diff --git a/tcllib/modules/rc4/rc4.test b/tcllib/modules/rc4/rc4.test
new file mode 100644
index 0000000..9aabd64
--- /dev/null
+++ b/tcllib/modules/rc4/rc4.test
@@ -0,0 +1,273 @@
+# rc4.test - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# $Id: rc4.test,v 1.12 2006/10/09 21:41:41 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.2
+testsNeedTcltest 1.0
+
+testing {
+    useLocal rc4.tcl rc4
+}
+
+# -------------------------------------------------------------------------
+
+if {[llength [info commands ::rc4::rc4c]]} {
+    puts "> critcl"
+}
+
+# -------------------------------------------------------------------------
+# Now the package specific tests....
+# -------------------------------------------------------------------------
+
+test rc4-1.0 {rc4 basic command options} {
+    list [catch {::rc4::rc4} msg] $msg
+} {1 {wrong # args: should be "rc4 ?-hex? -key key -in channel | string"}}
+
+test rc4-1.1 {rc4 basic command options} {
+    list [catch {::rc4::rc4 -key secret} msg] $msg
+} {1 {wrong # args: should be "rc4 ?-hex? -key key -in channel | string"}}
+
+# -------------------------------------------------------------------------
+
+# Test vectors
+set tests {
+    "\x01\x23\x45\x67\x89\xab\xcd\xef"
+    "\x01\x23\x45\x67\x89\xab\xcd\xef" 
+    "\x75\xb7\x87\x80\x99\xe0\xc5\x96"
+
+    "\x01\x23\x45\x67\x89\xab\xcd\xef"
+    "\x00\x00\x00\x00\x00\x00\x00\x00"
+    "\x74\x94\xc2\xe7\x10\x4b\x08\x79"
+
+    "\x00\x00\x00\x00\x00\x00\x00\x00"
+    "\x00\x00\x00\x00\x00\x00\x00\x00"
+    "\xde\x18\x89\x41\xa3\x37\x5d\x3a"
+
+    "\xef\x01\x23\x45"
+    "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
+    "\xd6\xa1\x41\xa7\xec\x3c\x38\xdf\xbd\x61"
+}
+
+lappend tests \
+    "\x01\x23\x45\x67\x89\xab\xcd\xef" \
+    [string repeat \x01 512] \
+    [binary format H* \
+         [join \
+              "75 95 c3 e6 11 4a 09 78 0c 4a d4 52 33 8e 1f fd 9a 1b e9 49\
+               8f 81 3d 76 53 34 49 b6 77 8d ca d8 c7 8a 8d 2b a9 ac 66 08\
+               5d 0e 53 d5 9c 26 c2 d1 c4 90 c1 eb be 0c e6 6d 1b 6b 1b 13\
+               b6 b9 19 b8 47 c2 5a 91 44 7a 95 e7 5e 4e f1 67 79 cd e8 bf\
+               0a 95 85 0e 32 af 96 89 44 4f d3 77 10 8f 98 fd cb d4 e7 26\
+               56 75 00 99 0b cc 7e 0c a3 c4 aa a3 04 a3 87 d2 0f 3b 8f bb\
+               cd 42 a1 bd 31 1d 7a 43 03 dd a5 ab 07 88 96 ae 80 c1 8b 0a\
+               f6 6d ff 31 96 16 eb 78 4e 49 5a d2 ce 90 d7 f7 72 a8 17 47\
+               b6 5f 62 09 3b 1e 0d b9 e5 ba 53 2f af ec 47 50 83 23 e6 71\
+               32 7d f9 44 44 32 cb 73 67 ce c8 2f 5d 44 c0 d0 0b 67 d6 50\
+               a0 75 cd 4b 70 de dd 77 eb 9b 10 23 1b 6b 5b 74 13 47 39 6d\
+               62 89 74 21 d4 3d f9 b4 2e 44 6e 35 8e 9c 11 a9 b2 18 4e cb\
+               ef 0c d8 e7 a8 77 ef 96 8f 13 90 ec 9b 3d 35 a5 58 5c b0 09\
+               29 0e 2f cd e7 b5 ec 66 d9 08 4b e4 40 55 a6 19 d9 dd 7f c3\
+               16 6f 94 87 f7 cb 27 29 12 42 64 45 99 85 14 c1 5d 53 a1 8c\
+               86 4c e3 a2 b7 55 57 93 98 81 26 52 0e ac f2 e3 06 6e 23 0c\
+               91 be e4 dd 53 04 f5 fd 04 05 b3 5b d9 9c 73 13 5d 3d 9b c3\
+               35 ee 04 9e f6 9b 38 67 bf 2d 7b d1 ea a5 95 d8 bf c0 06 6f\
+               f8 d3 15 09 eb 0c 6c aa 00 6c 80 7a 62 3e f8 4c 3d 33 c1 95\
+               d2 3e e3 20 c4 0d e0 55 81 57 c8 22 d4 b8 c5 69 d8 49 ae d5\
+               9d 4e 0f d7 f3 79 58 6b 4b 7f f6 84 ed 6a 18 9f 74 86 d4 9b\
+               9c 4b ad 9b a2 4b 96 ab f9 24 37 2c 8a 8f ff b1 0d 55 35 49\
+               00 a7 7a 3d b5 f2 05 e1 b9 9f cd 86 60 86 3a 15 9a d4 ab e4\
+               0f a4 89 34 16 3d dd e5 42 a6 58 55 40 fd 68 3c bf d8 c0 0f\
+               12 12 9a 28 4d ea cc 4c de fe 58 be 71 37 54 1c 04 71 26 c8\
+               d4 9e 27 55 ab 18 1a b7 e9 40 b0 c0" {}]]
+
+if {[llength [info commands ::rc4::rc4c]] != 0} {
+    set n 0
+    foreach {key input output} $tests {
+        test rc4-critcl-2.$n {rc4 test vectors (critcl based)} {
+            list [catch {::rc4::rc4 -key $key $input} msg] $msg
+        } [list 0 $output]
+        incr n
+    }
+}
+
+puts "> pure Tcl - array based"
+::rc4::SelectImplementation array
+set n 0
+foreach {key input output} $tests {
+    test rc4-array-2.$n {rc4 test vectors (pure tcl array based)} {
+        list [catch {::rc4::rc4 -key $key $input} msg] $msg
+    } [list 0 $output]
+    incr n
+}
+
+puts "> pure Tcl - list based"
+::rc4::SelectImplementation list
+set n 0
+foreach {key input output} $tests {
+    test rc4-list-2.$n {rc4 test vectors (pure tcl list based)} {
+        list [catch {::rc4::rc4 -key $key $input} msg] $msg
+    } [list 0 $output]
+    incr n
+}
+
+test rc4-3.0 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key - \0} msg] $msg
+} {0 9d}
+
+test rc4-3.1 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key -- \0} msg] $msg
+} {0 9d}
+
+test rc4-3.2 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key - -} msg] $msg
+} {0 b0}
+
+test rc4-3.3 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key - --} msg] $msg
+} {0 b046}
+
+test rc4-3.4 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key - -- -} msg] $msg
+} {0 b0}
+
+test rc4-3.5 {rc4 check hyphen handling} {
+    list [catch {rc4::rc4 -hex -key - -- --} msg] $msg
+} {0 b046}
+
+test rc4-4.0 {check file reading} {
+    list [catch {
+        set f [open [set path [makeFile {} rc4test.data]] w]
+        fconfigure $f -translation lf -eofchar {} -encoding binary
+        puts -nonewline $f "\0\1\2"
+        close $f
+        set res [rc4::rc4 -hex -key 01234567 -infile $path]
+        removeFile rc4test.data
+        set res
+    } msg] $msg
+} {0 91d4f1}
+
+test rc4-4.1 {check channel reading} {
+    list [catch {
+        set f [open [set path [makeFile {} rc4test.data]] w]
+        fconfigure $f -translation lf -eofchar {} -encoding binary
+        puts -nonewline $f "\0\1\2"
+        close $f
+
+        set f [open $path r]
+        fconfigure $f -translation lf -eofchar {} -encoding binary
+        set r [rc4::rc4 -hex -key 01234567 -in $f]
+        close $f
+        removeFile rc4test.data
+        set r
+    } msg] $msg
+} {0 91d4f1}
+
+test rc4-4.2 {check channel output} {
+    list [catch {
+        set f [open [makeFile {} rc4test.data] w+]
+        fconfigure $f -translation lf -eofchar {} -encoding binary
+        set r [rc4::rc4 -hex -key 01234567 -out $f "abcdef"]
+        seek $f 0
+        set s [rc4::Hex [read $f]]
+        close $f
+        removeFile rc4test.data
+        list $r $s
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+test rc4-4.3 {check channel input and output} {
+    list [catch {
+        set f [open [makeFile {} rc4test.data] w+]
+        fconfigure $f -translation lf -eofchar {} -encoding binary
+        puts -nonewline $f "abcdef"
+        seek $f 0
+        set g [open [makeFile {} rc4test2.data] w+]
+        fconfigure $g -translation lf -eofchar {} -encoding binary
+        set r [rc4::rc4 -hex -key 01234567 -in $f -out $g]
+        close $f
+        seek $g 0
+        set s [rc4::Hex [read $g]]
+        close $g
+        removeFile rc4test.data
+        removeFile rc4test2.data
+        list $r $s
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+proc ::rc4::TestCommandProc {junk data} {
+    if {[string compare $junk "JuNk"] != 0} {
+        set ::rc4::_test magicfailure
+    } else {
+        set ::rc4::_test [Hex $data]
+    }
+}
+
+test rc4-5.0 {check -command option} {
+    set ::rc4::_test unset
+    list [catch {
+        set r [rc4::rc4 -key 01234567 \
+                   -command [list ::rc4::TestCommandProc JuNk] "abcdef"]
+        list $r $::rc4::_test
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+test rc4-5.1 {check -command option (-hex should be ignored)} {
+    set ::rc4::_test unset
+    list [catch {
+        set r [rc4::rc4 -hex -key 01234567 \
+                   -command [list ::rc4::TestCommandProc JuNk] "abcdef"]
+        list $r $::rc4::_test
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+test rc4-5.2 {check -command option with channel input} {
+    set ::rc4::_test unset
+    list [catch {
+        set f [open [makeFile {} rc4test.data] w+]
+        fconfigure $f -translation lf -eofchar {} -encoding binary        
+        puts -nonewline $f "abcdef"
+        seek $f 0
+        set id [after 1000 {set ::rc4::_test timeout}]
+        set r [rc4::rc4 -key 01234567 -in $f \
+                   -command [list ::rc4::TestCommandProc JuNk]]
+        vwait ::rc4::_test
+        after cancel $id
+        close $f
+        removeFile rc4test.data
+        list $r $::rc4::_test
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+test rc4-5.3 {check -command option with file input} {
+    set ::rc4::_test unset
+    list [catch {
+        set f [open [set path [makeFile {} rc4test.data]] w]
+        fconfigure $f -translation lf -eofchar {} -encoding binary        
+        puts -nonewline $f "abcdef"
+        close $f
+        set id [after 1000 {set ::rc4::_test timeout}]
+        set r [rc4::rc4 -key 01234567 -infile $path \
+                   -command [list ::rc4::TestCommandProc JuNk]]
+        vwait ::rc4::_test
+        after cancel $id
+        removeFile rc4test.data
+        list $r $::rc4::_test
+    } msg] $msg
+} {0 {{} f0b7907b2341}}
+
+# -------------------------------------------------------------------------
+
+catch {unset ::rc4::_test}
+rename ::rc4::TestCommandProc {}
+testsuiteCleanup
+
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
diff --git a/tcllib/modules/rc4/rc4c.tcl b/tcllib/modules/rc4/rc4c.tcl
new file mode 100644
index 0000000..fd717df
--- /dev/null
+++ b/tcllib/modules/rc4/rc4c.tcl
@@ -0,0 +1,168 @@
+# rc4c.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# This provides a critcl C implementation of RC4 
+#
+# INSTALLATION
+# ------------
+# This package uses critcl (http://wiki.tcl.tk/critcl). To build do:
+#  critcl -libdir <your-tcl-lib-dir> -pkg rc4c rc4c
+#
+# To build this for tcllib use sak.tcl:
+#  tclsh sak.tcl critcl
+# generates a tcllibc module.
+#
+# $Id: rc4c.tcl,v 1.4 2009/05/07 00:14:02 patthoyts Exp $
+
+package require critcl
+# @sak notprovided rc4c
+package provide rc4c 1.1.0
+
+namespace eval ::rc4 {
+
+    critcl::ccode {
+        #include <string.h>
+
+        typedef struct RC4_CTX {
+            unsigned char x;
+            unsigned char y;
+            unsigned char s[256];
+        } RC4_CTX;
+
+        /* #define TRACE trace */
+        #define TRACE 1 ? ((void)0) : trace
+
+        static void trace(const char *format, ...)
+        {
+            va_list args;
+            va_start(args, format);
+            vfprintf(stderr, format, args);
+            va_end(args);
+        }
+        static Tcl_ObjType rc4_type;
+    
+        static void rc4_free_rep(Tcl_Obj *obj)
+        {
+            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
+            TRACE("rc4_free_rep(%08x)\n", (long)obj);
+            Tcl_Free((char *)ctx);
+        }
+
+        static void rc4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup)
+        {
+            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
+            TRACE("rc4_dup_rep(%08x,%08x)\n", (long)obj, (long)dup);
+            dup->internalRep.otherValuePtr = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX));
+            memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(RC4_CTX));
+            dup->typePtr = &rc4_type;
+        }
+
+        static void rc4_string_rep(Tcl_Obj* obj)
+        {
+            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
+            Tcl_Obj* tmpObj;
+            char* str;
+            TRACE("rc4_string_rep(%08x)\n", (long)obj);
+            /* convert via a byte array to properly handle null bytes */
+            tmpObj = Tcl_NewByteArrayObj((unsigned char *)ctx, sizeof(RC4_CTX));
+            Tcl_IncrRefCount(tmpObj);
+            
+            str = Tcl_GetStringFromObj(tmpObj, &obj->length);
+            obj->bytes = Tcl_Alloc(obj->length + 1);
+            memcpy(obj->bytes, str, obj->length + 1);
+            
+            Tcl_DecrRefCount(tmpObj);
+        }
+
+        static int rc4_from_any(Tcl_Interp* interp, Tcl_Obj* obj)
+        {
+            TRACE("rc4_from_any %08x\n", (long)obj);
+            return TCL_ERROR;
+        }
+
+        static Tcl_ObjType rc4_type = {
+            "rc4c", rc4_free_rep, rc4_dup_rep, rc4_string_rep, rc4_from_any
+        };
+#ifdef __GNUC__
+        inline
+#elif defined(_MSC_VER)
+        __inline
+#endif
+        void swap (unsigned char *lhs, unsigned char *rhs) {
+            unsigned char t = *lhs;
+            *lhs = *rhs;
+            *rhs = t;
+        }
+    }
+
+    critcl::ccommand rc4c_init {dummy interp objc objv} {
+        RC4_CTX *ctx;
+        Tcl_Obj *obj;
+        const unsigned char *k;
+        int n = 0, i = 0, j = 0, keylen;
+
+        if (objc != 2) {
+            Tcl_WrongNumArgs(interp, 1, objv, "keystring");
+            return TCL_ERROR;
+        }
+        
+        k = Tcl_GetByteArrayFromObj(objv[1], &keylen);
+
+        obj = Tcl_NewObj();
+        ctx = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX));
+        ctx->x = 0;
+        ctx->y = 0;
+        for (n = 0; n < 256; n++)
+            ctx->s[n] = n;
+        for (n = 0; n < 256; n++) {
+            j = (k[i] + ctx->s[n] + j) % 256;
+            swap(&ctx->s[n], &ctx->s[j]);
+            i = (i + 1) % keylen;
+        }
+        
+        if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL)
+            obj->typePtr->freeIntRepProc(obj);
+        obj->internalRep.otherValuePtr = ctx;
+        obj->typePtr = &rc4_type;
+        Tcl_InvalidateStringRep(obj);
+        Tcl_SetObjResult(interp, obj);
+        return TCL_OK;
+    }
+
+    critcl::ccommand rc4c {dummy interp objc objv} {
+        Tcl_Obj *resObj = NULL;
+        RC4_CTX *ctx = NULL;
+        unsigned char *data, *res, x, y;
+        int size, n, i;
+
+        if (objc != 3) {
+            Tcl_WrongNumArgs(interp, 1, objv, "key data");
+            return TCL_ERROR;
+        }
+
+        if (objv[1]->typePtr != &rc4_type
+            && rc4_from_any(interp, objv[1]) != TCL_OK) {
+            return TCL_ERROR;
+        }
+
+        ctx = objv[1]->internalRep.otherValuePtr;
+        data = Tcl_GetByteArrayFromObj(objv[2], &size);
+        res = (unsigned char *)Tcl_Alloc(size);
+
+        x = ctx->x;
+        y = ctx->y;
+        for (n = 0; n < size; n++) {
+            x = (x + 1) % 256;
+            y = (ctx->s[x] + y) % 256;
+            swap(&ctx->s[x], &ctx->s[y]);
+            i = (ctx->s[x] + ctx->s[y]) % 256;
+            res[n] = data[n] ^ ctx->s[i];
+        }
+        ctx->x = x;
+        ctx->y = y;
+
+        resObj = Tcl_NewByteArrayObj(res, size);
+        Tcl_SetObjResult(interp, resObj);
+        Tcl_Free((char*)res);
+        return TCL_OK;
+    }
+}