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