summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/rc4
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/modules/rc4')
-rw-r--r--tcllib/modules/rc4/ChangeLog134
-rw-r--r--tcllib/modules/rc4/pkgIndex.tcl13
-rw-r--r--tcllib/modules/rc4/rc4.bench64
-rw-r--r--tcllib/modules/rc4/rc4.man120
-rw-r--r--tcllib/modules/rc4/rc4.tcl422
-rw-r--r--tcllib/modules/rc4/rc4.test273
-rw-r--r--tcllib/modules/rc4/rc4c.tcl168
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;
+ }
+}
generated by cgit v0.12 at 2024-12-27 09:14:31 (GMT)