MemeRot's Journal: RC4 encryption in tcl 7.6, StoryServer 4

[
##
##    INPUTS:        plainText
##
##    RETURNS:    cipherText
##
##    NOTES:        Conversion to Hex values may not
##      have been necessary, but was much easier to debug
##    See references at www.ncat.edu/~grogans and
##    http://www.tillerman.st/ietf/rodney_drafts/draft-kaukonen-cipher-arcfour-01.txt
##
##      This has been tested and found to match RC4, using
##      the perl module, also the public examples.
##      This was written for StoryServer 4.2, which is
##      based on tcl 7.6 (i.e. no binary stream, namespaces)
##
##      Tcl'ers, some of the syntax is slightly different,
##      not very though.
##
##      cypherText is created as a variable with the
##      encrypted string, not returned as the return value
##      from this function.

proc RC4_encrypt {plainText} {
    ## Must set these globally - but its global
    ## TO THIS PROCEDURE only
    global buffer S i enewsKey hexKeyList keyList enewsHex K f c HexVal plainList ccList l resultSet cipherText counter cardLen base64String

    for {set loop 0} {$loop <= 255} {incr loop} {
       append buffer " $loop "
    }

    ## Create a State array consisting of the numbers
    ## 0 through 255
    FOREACH num IN $buffer {
        [array set S [list $num $num]
        NULL]
    }

    ## The cipher key. Guard it.
    ## Put your own key in here, this will resolve to
    ## slashtroll

    set cipherKey [DECODE64 "c2xhc2h0cm9sbA=="]

    ## Its much easier to deal with the algorithm in
    ## hex and decimal than strings, so do that. This
    ## creates a list of the hex values.

        for {set l 0} {$l < [string length [SHOW cipherKey]]} {incr l} {
        scan [string index [SHOW cipherKey] [SHOW l]] %c keyInts
        lappend hexKeyList [format %X $keyInts]
    }

    ## destroy the key so that if there is a stack dump
    ## it is not compromised.
    unset cipherKey

    ## Make the key decimal, expand it to fill 256
    ## places in an array
    FOREACH HexVal IN [SHOW hexKeyList] {
        [scan $HexVal %x KeyStr]
        [lappend keyList $KeyStr]
    }
    set i 0
    for {set loop 1} {$loop <= 32} {incr loop} {
        for {set doubleloop 0} {$doubleloop <= 7} {incr doubleloop} {
            array set cypherHex [list $i [lindex $keyList $doubleloop]]
            incr i
        }
    }
    FOREACH num IN $buffer {
        [array set K [list $num $cypherHex($num)]
        NULL]
    }

    ## Delete more key variables in case of stack dump.
    unset hexKeyList keyList cypherHex

    ## Use the key array to mix the state array into an
    ## encrypting variable array
    set i 0
    set f 0
    FOREACH i IN $buffer {
        [SET f [expr ($f + $S($i) + $K($i)) % 256]]
        [SET tempVal $S($i)]
        [array set S [list $i $S($f)]
        NULL]
        [array set S [list $f $tempVal]
        NULL]
    }

    ## Get rid of the Key array. Now it should not be
    ## feasable for a user to crash the system with
    ## invalid plaintext and derive the key from any
    ## existing variables.
    unset K

    ## Create a hex, then decimal list of the plaintext
    set i 0
    set f 0
    set c 0
    for {set l 0} {$l < [string length $plainText]} {incr l} {
        lappend ccList [string index $plainText $l]
    }
    FOREACH HexVal IN [SHOW ccList] {
        [scan $HexVal %c plainStr]
        [lappend plainList $plainStr]
    }

    ## Encrypt the plaintext by deriving a number from
    ## the encrypting variable array to use and
    ## XOR'ing  it with the value of the plaintext
    FOREACH num IN $plainList {
        [SET i [expr ($i + 1) % 256]]
        [SET f [expr ($f + $S($i)) % 256]]
        [SET tempVal $S($i)]
        [array set S [list $i $S($f)]
        NULL]
        [array set S [list $f $tempVal]
        NULL]
        [SET t [expr ($S($i) + $S($f)) % 256]]
        [SET encrByte $S($t)]
            [array set resultSet [list $c [expr $num ^ $encrByte]]
        incr c
        NULL]
    }
    SET base64String "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    set counter 0
    set cardLen [array size resultSet]
    FOREACH num IN {1 2 3 4 5 6} {
        [IF {[SHOW counter] != [SHOW cardLen]} {
            [append cipherText [string index $base64String [expr [SHOW resultSet([SHOW counter])] / 4]]]
            [incr counter; NULL]
            [IF {[SHOW counter] != [SHOW cardLen]} {
                [append cipherText [string index $base64String [expr ([SHOW resultSet([expr [SHOW counter] - 1])] % 4) * 16 + ([SHOW resultSet([SHOW counter])] / 16)]]]
                [incr counter; NULL]
                [IF {[SHOW counter] != [SHOW cardLen]} {
                    [append cipherText [string index $base64String [expr ([SHOW resultSet([expr [SHOW counter] - 1])] % 16) * 4 + ([SHOW resultSet([SHOW counter])] / 64)]]]
                    [append cipherText [string index $base64String [expr [SHOW resultSet([SHOW counter])] % 64]]]
                    [incr counter; NULL]
                } ELSE {
                    [append cipherText [string index $base64String [expr ([SHOW resultSet([expr [SHOW counter] - 1])] % 16) * 4]]]
                    [append cipherText "="]
                }]
            } ELSE {
                [append cipherText [string index $base64String [expr ([SHOW resultSet([expr [SHOW counter] - 1])] % 4) * 16]]]
                [append cipherText "=="]
            }]
        }]
    }

    unset buffer S i f c HexVal plainList ccList l resultSet counter cardLen base64String
    return
}]