1# rc4c.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
2#
3# This provides a critcl C implementation of RC4
4#
5# INSTALLATION
6# ------------
7# This package uses critcl (http://wiki.tcl.tk/critcl). To build do:
8#  critcl -libdir <your-tcl-lib-dir> -pkg rc4c rc4c
9#
10# To build this for tcllib use sak.tcl:
11#  tclsh sak.tcl critcl
12# generates a tcllibc module.
13#
14# $Id: rc4c.tcl,v 1.4 2009/05/07 00:14:02 patthoyts Exp $
15
16package require critcl
17# @sak notprovided rc4c
18package provide rc4c 1.1.0
19
20namespace eval ::rc4 {
21
22    critcl::ccode {
23        typedef struct RC4_CTX {
24            unsigned char x;
25            unsigned char y;
26            unsigned char s[256];
27        } RC4_CTX;
28
29        /* #define TRACE trace */
30        #define TRACE 1 ? ((void)0) : trace
31
32        static void trace(const char *format, ...)
33        {
34            va_list args;
35            va_start(args, format);
36            vfprintf(stderr, format, args);
37            va_end(args);
38        }
39        static Tcl_ObjType rc4_type;
40
41        static void rc4_free_rep(Tcl_Obj *obj)
42        {
43            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
44            TRACE("rc4_free_rep(%08x)\n", (long)obj);
45            Tcl_Free((char *)ctx);
46        }
47
48        static void rc4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup)
49        {
50            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
51            TRACE("rc4_dup_rep(%08x,%08x)\n", (long)obj, (long)dup);
52            dup->internalRep.otherValuePtr = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX));
53            memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(RC4_CTX));
54            dup->typePtr = &rc4_type;
55        }
56
57        static void rc4_string_rep(Tcl_Obj* obj)
58        {
59            RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr;
60            Tcl_Obj* tmpObj;
61            char* str;
62            TRACE("rc4_string_rep(%08x)\n", (long)obj);
63            /* convert via a byte array to properly handle null bytes */
64            tmpObj = Tcl_NewByteArrayObj((char *)ctx, sizeof(RC4_CTX));
65            Tcl_IncrRefCount(tmpObj);
66
67            str = Tcl_GetStringFromObj(tmpObj, &obj->length);
68            obj->bytes = Tcl_Alloc(obj->length + 1);
69            memcpy(obj->bytes, str, obj->length + 1);
70
71            Tcl_DecrRefCount(tmpObj);
72        }
73
74        static int rc4_from_any(Tcl_Interp* interp, Tcl_Obj* obj)
75        {
76            TRACE("rc4_from_any %08x\n", (long)obj);
77            return TCL_ERROR;
78        }
79
80        static Tcl_ObjType rc4_type = {
81            "rc4c", rc4_free_rep, rc4_dup_rep, rc4_string_rep, rc4_from_any
82        };
83#ifdef __GNUC__
84        inline
85#elif defined(_MSC_VER)
86        __inline
87#endif
88        void swap (unsigned char *lhs, unsigned char *rhs) {
89            unsigned char t = *lhs;
90            *lhs = *rhs;
91            *rhs = t;
92        }
93    }
94
95    critcl::ccommand rc4c_init {dummy interp objc objv} {
96        RC4_CTX *ctx;
97        Tcl_Obj *obj;
98        const unsigned char *k;
99        int n = 0, i = 0, j = 0, keylen;
100
101        if (objc != 2) {
102            Tcl_WrongNumArgs(interp, 1, objv, "keystring");
103            return TCL_ERROR;
104        }
105
106        k = Tcl_GetByteArrayFromObj(objv[1], &keylen);
107
108        obj = Tcl_NewObj();
109        ctx = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX));
110        ctx->x = 0;
111        ctx->y = 0;
112        for (n = 0; n < 256; n++)
113            ctx->s[n] = n;
114        for (n = 0; n < 256; n++) {
115            j = (k[i] + ctx->s[n] + j) % 256;
116            swap(&ctx->s[n], &ctx->s[j]);
117            i = (i + 1) % keylen;
118        }
119
120        if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL)
121            obj->typePtr->freeIntRepProc(obj);
122        obj->internalRep.otherValuePtr = ctx;
123        obj->typePtr = &rc4_type;
124        Tcl_InvalidateStringRep(obj);
125        Tcl_SetObjResult(interp, obj);
126        return TCL_OK;
127    }
128
129    critcl::ccommand rc4c {dummy interp objc objv} {
130        Tcl_Obj *resObj = NULL;
131        RC4_CTX *ctx = NULL;
132        unsigned char *data, *res, x, y;
133        int size, n, i;
134
135        if (objc != 3) {
136            Tcl_WrongNumArgs(interp, 1, objv, "key data");
137            return TCL_ERROR;
138        }
139
140        if (objv[1]->typePtr != &rc4_type
141            && rc4_from_any(interp, objv[1]) != TCL_OK) {
142            return TCL_ERROR;
143        }
144
145        ctx = objv[1]->internalRep.otherValuePtr;
146        data = Tcl_GetByteArrayFromObj(objv[2], &size);
147        res = (unsigned char *)Tcl_Alloc(size);
148
149        x = ctx->x;
150        y = ctx->y;
151        for (n = 0; n < size; n++) {
152            x = (x + 1) % 256;
153            y = (ctx->s[x] + y) % 256;
154            swap(&ctx->s[x], &ctx->s[y]);
155            i = (ctx->s[x] + ctx->s[y]) % 256;
156            res[n] = data[n] ^ ctx->s[i];
157        }
158        ctx->x = x;
159        ctx->y = y;
160
161        resObj = Tcl_NewByteArrayObj(res, size);
162        Tcl_SetObjResult(interp, resObj);
163        Tcl_Free(res);
164        return TCL_OK;
165    }
166}
167