diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/md4 | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/md4')
-rw-r--r-- | tcllib/modules/md4/ChangeLog | 209 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.bench | 46 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.c | 301 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.h | 79 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.man | 168 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.tcl | 571 | ||||
-rw-r--r-- | tcllib/modules/md4/md4.test | 290 | ||||
-rw-r--r-- | tcllib/modules/md4/md4_check.c | 62 | ||||
-rw-r--r-- | tcllib/modules/md4/md4c.tcl | 120 | ||||
-rw-r--r-- | tcllib/modules/md4/pkgIndex.tcl | 3 |
10 files changed, 1849 insertions, 0 deletions
diff --git a/tcllib/modules/md4/ChangeLog b/tcllib/modules/md4/ChangeLog new file mode 100644 index 0000000..7c8c606 --- /dev/null +++ b/tcllib/modules/md4/ChangeLog @@ -0,0 +1,209 @@ +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-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4c.tcl: Fixed a leak in the critcl implemented due to + mismanaged reference counting. + +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 ======================== + * + +2008-04-29 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Clean up variables after intialization. + * pkgIndex.tcl: Bumped to 1.0.5 + +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> + + * md4.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-09-19 Andreas Kupries <andreask@activestate.com> + + * md4.man: Bumped version to 1.0.4 + * md4.tcl: + * pkgIndex.tcl: + +2006-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md4.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md4.test: Hooked into the new common test support code. + +2005-10-24 Andreas Kupries <andreask@activestate.com> + + * md4.bench: New file. Basic benchmarks for MD4 hashes. + +2005-10-17 Andreas Kupries <andreask@activestate.com> + + * md4.tcl: Trivial comment typo fix. + +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> + + * md4c.tcl: Fix to permit compilation with msvc + * md4.h: + +2005-02-24 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Arranged to run all available implementations in + * md4.test: the tests. + +2005-02-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * pkgIndex.tcl: Incremented version to 1.0.3 + * md4.tcl: Rationalized the accelerator package handling. + * md4.test: Added cryptkit as a potential accelerator. + * md4.man: Added mention of the accelerators. + +2005-02-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Fixed the tests to use both critcl and pure-Tcl + * md4.test: if the critcl version is available. + + * md4.tcl: Made hashing cope with data that begins with a + * md4.test: hyphen and made the '--' end-of-options marker + * md4.man: optional. Incremented version. + * pkgIndex.tcl: + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md4.tcl: Updated version number to sync with 1.6.1 + * md4.man: release. + * pkgIndex.tcl: + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md4.tcl: Rel. engineering. Updated version number + * md4.man: of md4 to reflect its changes, to 1.0.2. + * pkgIndex.tcl: + +2004-02-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Streamlined the rotate-left function and fixed a rare + bug that occurs if the hash result produces a hypen as the first + character and we are using Trf's hex function. + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-08 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Remove frink warnings to quieten sak validate. + +2003-05-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Changed the method MD4Final uses to produce the binary + result to avoid problems on 64bit architectures. + * md4.c: Removed the c_src subdirectory and moved all files + * md4.h: into the md4 module directory. We want to keep the + * md4c.tcl: source tree as flat as possible. + * md4.tcl, md4.man, pkgIndex.tcl: Hiked version to 1.0.1 + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-30 Pat Thoyts <Patrick.Thoyts@renishaw.com> + + * md4.man: Added documentation for the hmac command and for the + programming interface to the MD4 algorithm. + * md4c.tcl: Fixed md5c attribution. + +2003-04-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4c.tcl: Added critcl-based C implementation md4c. + * md4.tcl: Enable use of md4c if available. + * md4.test: Report the implmentation (C or pure-tcl) + * c_src/md4.h: The md4 implementation from RFC1320 + * c_src/md4.c: + +2003-04-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.test: Added a series of tests to check all lengths of input + up to over 2 MD4 block lengths. + * md4_check.c: Included the C code used to generate the new test + results from the OpenSSL MD4 implementation. + +2003-04-16 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.tcl: Implemented chunked reading from file or + channel, added -file and -channel options to md4. + Implemented hmac command with -key option. + Provide MD4Init, MD4Update, MD4Final as per C-usage to permit use + on streaming data. + +2003-04-15 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md4.test: + * md4.tcl: + * md4.man: + * ChangeLog: Initial versions. + diff --git a/tcllib/modules/md4/md4.bench b/tcllib/modules/md4/md4.bench new file mode 100644 index 0000000..f9a31e8 --- /dev/null +++ b/tcllib/modules/md4/md4.bench @@ -0,0 +1,46 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'md4' 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 md4 +catch {namespace delete ::md4} +source [file join [file dirname [info script]] md4.tcl] + +set key "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "MD4 md4_ $n" -pre { + set str [string repeat " " $n] + } -body { + md4::md4 $str + } + + bench -desc "MD4 hmac $n" -pre { + set str [string repeat " " $n] + } -body { + md4::hmac -key $key $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/md4/md4.c b/tcllib/modules/md4/md4.c new file mode 100644 index 0000000..c9b49c2 --- /dev/null +++ b/tcllib/modules/md4/md4.c @@ -0,0 +1,301 @@ +/* MD4C.C - RSA Data Security, Inc., MD4 message-digest algorithm + */ + +/* Copyright (C) 1990-2, RSA Data Security, Inc. All rights reserved. + + License to copy and use this software is granted provided that it + is identified as the "RSA Data Security, Inc. MD4 Message-Digest + Algorithm" in all material mentioning or referencing this software + or this function. + + License is also granted to make and use derivative works provided + that such works are identified as "derived from the RSA Data + Security, Inc. MD4 Message-Digest Algorithm" in all material + mentioning or referencing the derived work. + + RSA Data Security, Inc. makes no representations concerning either + the merchantability of this software or the suitability of this + software for any particular purpose. It is provided "as is" + without express or implied warranty of any kind. + + These notices must be retained in any copies of any part of this + documentation and/or software. + */ + +#include "md4.h" + +/* Constants for MD4Transform routine. + */ +#define S11 3 +#define S12 7 +#define S13 11 +#define S14 19 +#define S21 3 +#define S22 5 +#define S23 9 +#define S24 13 +#define S31 3 +#define S32 9 +#define S33 11 +#define S34 15 + +static void MD4Transform PROTO_LIST ((UINT4 [4], unsigned char [64])); +static void Encode PROTO_LIST + ((unsigned char *, UINT4 *, unsigned int)); +static void Decode PROTO_LIST + ((UINT4 *, unsigned char *, unsigned int)); +static void MD4_memcpy PROTO_LIST ((POINTER, POINTER, unsigned int)); +static void MD4_memset PROTO_LIST ((POINTER, int, unsigned int)); + +static unsigned char PADDING[64] = { + 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 +}; + +/* F, G and H are basic MD4 functions. + */ +#define F(x, y, z) (((x) & (y)) | ((~x) & (z))) +#define G(x, y, z) (((x) & (y)) | ((x) & (z)) | ((y) & (z))) +#define H(x, y, z) ((x) ^ (y) ^ (z)) + +/* ROTATE_LEFT rotates x left n bits. + */ +#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n)))) + +/* FF, GG and HH are transformations for rounds 1, 2 and 3 */ +/* Rotation is separate from addition to prevent recomputation */ + +#define FF(a, b, c, d, x, s) { \ + (a) += F ((b), (c), (d)) + (x); \ + (a) = ROTATE_LEFT ((a), (s)); \ + } +#define GG(a, b, c, d, x, s) { \ + (a) += G ((b), (c), (d)) + (x) + (UINT4)0x5a827999; \ + (a) = ROTATE_LEFT ((a), (s)); \ + } +#define HH(a, b, c, d, x, s) { \ + (a) += H ((b), (c), (d)) + (x) + (UINT4)0x6ed9eba1; \ + (a) = ROTATE_LEFT ((a), (s)); \ + } + +/* MD4 initialization. Begins an MD4 operation, writing a new context. + */ +void MD4Init (context) +MD4_CTX *context; /* context */ +{ + context->count[0] = context->count[1] = 0; + + /* Load magic initialization constants. + */ + context->state[0] = 0x67452301; + context->state[1] = 0xefcdab89; + context->state[2] = 0x98badcfe; + context->state[3] = 0x10325476; +} + +/* MD4 block update operation. Continues an MD4 message-digest + operation, processing another message block, and updating the + context. + */ +void MD4Update (context, input, inputLen) +MD4_CTX *context; /* context */ +unsigned char *input; /* input block */ +unsigned int inputLen; /* length of input block */ +{ + unsigned int i, index, partLen; + + /* Compute number of bytes mod 64 */ + index = (unsigned int)((context->count[0] >> 3) & 0x3F); + /* Update number of bits */ + if ((context->count[0] += ((UINT4)inputLen << 3)) + < ((UINT4)inputLen << 3)) + context->count[1]++; + context->count[1] += ((UINT4)inputLen >> 29); + + partLen = 64 - index; + + /* Transform as many times as possible. + */ + if (inputLen >= partLen) { + MD4_memcpy + ((POINTER)&context->buffer[index], (POINTER)input, partLen); + MD4Transform (context->state, context->buffer); + + for (i = partLen; i + 63 < inputLen; i += 64) + MD4Transform (context->state, &input[i]); + + index = 0; + } + else + i = 0; + + /* Buffer remaining input */ + MD4_memcpy + ((POINTER)&context->buffer[index], (POINTER)&input[i], + inputLen-i); +} + +/* MD4 finalization. Ends an MD4 message-digest operation, writing the + the message digest and zeroizing the context. + */ +void MD4Final (digest, context) +unsigned char digest[16]; /* message digest */ +MD4_CTX *context; /* context */ +{ + unsigned char bits[8]; + unsigned int index, padLen; + + /* Save number of bits */ + Encode (bits, context->count, 8); + + /* Pad out to 56 mod 64. + */ + index = (unsigned int)((context->count[0] >> 3) & 0x3f); + padLen = (index < 56) ? (56 - index) : (120 - index); + MD4Update (context, PADDING, padLen); + + /* Append length (before padding) */ + MD4Update (context, bits, 8); + /* Store state in digest */ + Encode (digest, context->state, 16); + + /* Zeroize sensitive information. + */ + MD4_memset ((POINTER)context, 0, sizeof (*context)); +} + +/* MD4 basic transformation. Transforms state based on block. + */ +static void MD4Transform (state, block) +UINT4 state[4]; +unsigned char block[64]; +{ + UINT4 a = state[0], b = state[1], c = state[2], d = state[3], x[16]; + + Decode (x, block, 64); + + /* Round 1 */ + FF (a, b, c, d, x[ 0], S11); /* 1 */ + FF (d, a, b, c, x[ 1], S12); /* 2 */ + FF (c, d, a, b, x[ 2], S13); /* 3 */ + FF (b, c, d, a, x[ 3], S14); /* 4 */ + FF (a, b, c, d, x[ 4], S11); /* 5 */ + FF (d, a, b, c, x[ 5], S12); /* 6 */ + FF (c, d, a, b, x[ 6], S13); /* 7 */ + FF (b, c, d, a, x[ 7], S14); /* 8 */ + FF (a, b, c, d, x[ 8], S11); /* 9 */ + FF (d, a, b, c, x[ 9], S12); /* 10 */ + FF (c, d, a, b, x[10], S13); /* 11 */ + FF (b, c, d, a, x[11], S14); /* 12 */ + FF (a, b, c, d, x[12], S11); /* 13 */ + FF (d, a, b, c, x[13], S12); /* 14 */ + FF (c, d, a, b, x[14], S13); /* 15 */ + FF (b, c, d, a, x[15], S14); /* 16 */ + + /* Round 2 */ + GG (a, b, c, d, x[ 0], S21); /* 17 */ + GG (d, a, b, c, x[ 4], S22); /* 18 */ + GG (c, d, a, b, x[ 8], S23); /* 19 */ + GG (b, c, d, a, x[12], S24); /* 20 */ + GG (a, b, c, d, x[ 1], S21); /* 21 */ + GG (d, a, b, c, x[ 5], S22); /* 22 */ + GG (c, d, a, b, x[ 9], S23); /* 23 */ + GG (b, c, d, a, x[13], S24); /* 24 */ + GG (a, b, c, d, x[ 2], S21); /* 25 */ + GG (d, a, b, c, x[ 6], S22); /* 26 */ + GG (c, d, a, b, x[10], S23); /* 27 */ + GG (b, c, d, a, x[14], S24); /* 28 */ + GG (a, b, c, d, x[ 3], S21); /* 29 */ + GG (d, a, b, c, x[ 7], S22); /* 30 */ + GG (c, d, a, b, x[11], S23); /* 31 */ + GG (b, c, d, a, x[15], S24); /* 32 */ + + /* Round 3 */ + HH (a, b, c, d, x[ 0], S31); /* 33 */ + HH (d, a, b, c, x[ 8], S32); /* 34 */ + HH (c, d, a, b, x[ 4], S33); /* 35 */ + HH (b, c, d, a, x[12], S34); /* 36 */ + HH (a, b, c, d, x[ 2], S31); /* 37 */ + HH (d, a, b, c, x[10], S32); /* 38 */ + HH (c, d, a, b, x[ 6], S33); /* 39 */ + HH (b, c, d, a, x[14], S34); /* 40 */ + HH (a, b, c, d, x[ 1], S31); /* 41 */ + HH (d, a, b, c, x[ 9], S32); /* 42 */ + HH (c, d, a, b, x[ 5], S33); /* 43 */ + HH (b, c, d, a, x[13], S34); /* 44 */ + HH (a, b, c, d, x[ 3], S31); /* 45 */ + HH (d, a, b, c, x[11], S32); /* 46 */ + HH (c, d, a, b, x[ 7], S33); /* 47 */ + HH (b, c, d, a, x[15], S34); /* 48 */ + + state[0] += a; + state[1] += b; + state[2] += c; + state[3] += d; + + /* Zeroize sensitive information. + */ + MD4_memset ((POINTER)x, 0, sizeof (x)); +} + +/* Encodes input (UINT4) into output (unsigned char). Assumes len is + a multiple of 4. + */ +static void Encode (output, input, len) +unsigned char *output; +UINT4 *input; +unsigned int len; +{ + unsigned int i, j; + + for (i = 0, j = 0; j < len; i++, j += 4) { + output[j] = (unsigned char)(input[i] & 0xff); + output[j+1] = (unsigned char)((input[i] >> 8) & 0xff); + output[j+2] = (unsigned char)((input[i] >> 16) & 0xff); + output[j+3] = (unsigned char)((input[i] >> 24) & 0xff); + } +} + +/* Decodes input (unsigned char) into output (UINT4). Assumes len is + a multiple of 4. + */ +static void Decode (output, input, len) + +UINT4 *output; +unsigned char *input; +unsigned int len; +{ + unsigned int i, j; + + for (i = 0, j = 0; j < len; i++, j += 4) + output[i] = ((UINT4)input[j]) | (((UINT4)input[j+1]) << 8) | + (((UINT4)input[j+2]) << 16) | (((UINT4)input[j+3]) << 24); +} + +/* Note: Replace "for loop" with standard memcpy if possible. + */ +static void MD4_memcpy (output, input, len) +POINTER output; +POINTER input; +unsigned int len; +{ + unsigned int i; + + for (i = 0; i < len; i++) + output[i] = input[i]; +} + +/* Note: Replace "for loop" with standard memset if possible. + */ +static void MD4_memset (output, value, len) +POINTER output; +int value; +unsigned int len; +{ + unsigned int i; + + for (i = 0; i < len; i++) + ((char *)output)[i] = (char)value; +} + diff --git a/tcllib/modules/md4/md4.h b/tcllib/modules/md4/md4.h new file mode 100644 index 0000000..22e0f93 --- /dev/null +++ b/tcllib/modules/md4/md4.h @@ -0,0 +1,79 @@ +/* MD4.H - header file for MD4C.C + */ + +/* Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All + rights reserved. + + License to copy and use this software is granted provided that it + is identified as the "RSA Data Security, Inc. MD4 Message-Digest + Algorithm" in all material mentioning or referencing this software + or this function. + + License is also granted to make and use derivative works provided + that such works are identified as "derived from the RSA Data + Security, Inc. MD4 Message-Digest Algorithm" in all material + mentioning or referencing the derived work. + + RSA Data Security, Inc. makes no representations concerning either + the merchantability of this software or the suitability of this + software for any particular purpose. It is provided "as is" + without express or implied warranty of any kind. + + These notices must be retained in any copies of any part of this + documentation and/or software. + */ + +#ifndef md4_h_INCLUDE +#define md4_h_INCLUDE + +#ifdef __cplusplus +extern "C" { +#endif + +/* PROTOTYPES should be set to one if and only if the compiler supports + function argument prototyping. + The following makes PROTOTYPES default to 0 if it has not already + been defined with C compiler flags. + */ +#ifndef PROTOTYPES +#define PROTOTYPES 1 +#endif + + +/* POINTER defines a generic pointer type */ +typedef unsigned char *POINTER; + +/* UINT2 defines a two byte word */ +typedef unsigned short int UINT2; + +/* UINT4 defines a four byte word */ +typedef unsigned int UINT4; + +/* PROTO_LIST is defined depending on how PROTOTYPES is defined above. + If using PROTOTYPES, then PROTO_LIST returns the list, otherwise it + returns an empty list. + */ + +#if PROTOTYPES +#define PROTO_LIST(list) list +#else +#define PROTO_LIST(list) () +#endif + +/* MD4 context. */ +typedef struct { + UINT4 state[4]; /* state (ABCD) */ + UINT4 count[2]; /* number of bits, modulo 2^64 (lsb first) */ + unsigned char buffer[64]; /* input buffer */ +} MD4_CTX; + +void MD4Init PROTO_LIST ((MD4_CTX *)); +void MD4Update PROTO_LIST + ((MD4_CTX *, unsigned char *, unsigned int)); +void MD4Final PROTO_LIST ((unsigned char [16], MD4_CTX *)); + +#ifdef __cplusplus +} +#endif + +#endif /* _md4_h_INCLUDE */ diff --git a/tcllib/modules/md4/md4.man b/tcllib/modules/md4/md4.man new file mode 100644 index 0000000..0427ba8 --- /dev/null +++ b/tcllib/modules/md4/md4.man @@ -0,0 +1,168 @@ +[vset VERSION 1.0.6] +[manpage_begin md4 n [vset VERSION]] +[see_also md5] +[see_also sha1] +[keywords hashing] +[keywords md4] +[keywords message-digest] +[keywords {rfc 1320}] +[keywords {rfc 1321}] +[keywords {rfc 2104}] +[keywords security] +[moddesc {MD4 Message-Digest Algorithm}] +[copyright {2003, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[titledesc {MD4 Message-Digest Algorithm}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require md4 [opt [vset VERSION]]] +[description] +[para] + +This package is an implementation in Tcl of the MD4 message-digest +algorithm as described in RFC 1320 (1) and (2). This algorithm takes +an arbitrary quantity of data and generates a 128-bit message digest +from the input. The MD4 algorithm is faster but potentially weaker than +the related MD5 algorithm (3). + +[para] + +If you have [package critcl] and have built the [package tcllibc] package +then the implementation of the hashing function will be performed by compiled +code. Alternatively if [package cryptkit] is available this will be +used. If no accelerator package can be found then the pure-tcl +implementation is used. The programming interface remains the same in +all cases. + +[section {COMMANDS}] + +[list_begin definitions] + +[call [cmd "::md4::md4"] \ + [opt "[arg -hex]"] \ + [lb] [arg "-channel channel"] | \ + [arg "-file filename"] | [arg "string"] [rb]] + +Calculate the MD4 digest of the data given in string. This is returned +as a binary string by default. Giving the [arg "-hex"] option will +return a hexadecimal encoded version of the digest. + +[para] + +The data to be hashed can be specified either as a string argument to +the md4 command, or as a filename or a pre-opened channel. If the +[arg "-filename"] argument is given then the file is opened, the data read +and hashed and the file is closed. If the [arg "-channel"] argument is +given then data is read from the channel until the end of file. The +channel is not closed. + +[para] + +Only one of [arg "-file"], [arg "-channel"] or [arg "string"] should be given. + +[call [cmd "::md4::hmac"] \ + [opt "[arg -hex]"] \ + [arg "-key key"] \ + [lb] [arg "-channel channel"] | \ + [arg "-file filename"] | [arg "string"] [rb]] + +Calculate an Hashed Message Authentication digest (HMAC) using the MD4 +digest algorithm. HMACs are described in RFC 2104 (4) and provide an MD4 +digest that includes a key. All options other than [arg -key] are as +for the [cmd "::md4::md4"] command. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +For the programmer, the MD4 hash can be viewed as a bucket into which +one pours data. When you have finished, you extract a value that is +derived from the data that was poured into the bucket. The programming +interface to the MD4 hash operates on a token (equivalent to the +bucket). You call [cmd MD4Init] to obtain a token and then call +[cmd MD4Update] as many times as required to add data to the hash. To +release any resources and obtain the hash value, you then call +[cmd MD4Final]. An equivalent set of functions gives you a keyed digest (HMAC). + +[list_begin definitions] + +[call [cmd "::md4::MD4Init"]] + +Begins a new MD4 hash. Returns a token ID that must be used for the +remaining functions. + +[call [cmd "::md4::MD4Update"] [arg "token"] [arg "data"]] + +Add data to the hash identified by token. Calling +[emph {MD4Update $token "abcd"}] is equivalent to calling +[emph {MD4Update $token "ab"}] followed by +[emph {MD4Update $token "cb"}]. See [sectref {EXAMPLES}]. + +[call [cmd "::md4::MD4Final"] [arg "token"]] + +Returns the hash value and releases any resources held by this +token. Once this command completes the token will be invalid. The +result is a binary string of 16 bytes representing the 128 bit MD4 +digest value. + +[call [cmd "::md4::HMACInit"] [arg "key"]] + +This is equivalent to the [cmd "::md4::MD4Init"] command except that +it requires the key that will be included in the HMAC. + +[call [cmd "::md4::HMACUpdate"] [arg "token"] [arg "data"]] +[call [cmd "::md4::HMACFinal"] [arg "token"]] + +These commands are identical to the MD4 equivalent commands. + +[list_end] + +[section {EXAMPLES}] + +[example { +% md4::md4 -hex "Tcl does MD4" +858da9b31f57648a032230447bd15f25 +}] + +[example { +% md4::hmac -hex -key Sekret "Tcl does MD4" +c324088e5752872689caedf2a0464758 +}] + +[example { +% set tok [md4::MD4Init] +::md4::1 +% md4::MD4Update $tok "Tcl " +% md4::MD4Update $tok "does " +% md4::MD4Update $tok "MD4" +% md4::Hex [md4::MD4Final $tok] +858da9b31f57648a032230447bd15f25 +}] + +[section {REFERENCES}] + +[list_begin enumerated] + +[enum] + Rivest, R., "The MD4 Message Digest Algorithm", RFC 1320, MIT, + April 1992. ([uri http://www.rfc-editor.org/rfc/rfc1320.txt]) + +[enum] + Rivest, R., "The MD4 message digest algorithm", in A.J. Menezes + and S.A. Vanstone, editors, Advances in Cryptology - CRYPTO '90 + Proceedings, pages 303-311, Springer-Verlag, 1991. + +[enum] + Rivest, R., "The MD5 Message-Digest Algorithm", RFC 1321, MIT and + RSA Data Security, Inc, April 1992. + ([uri http://www.rfc-editor.org/rfc/rfc1321.txt]) + +[enum] + Krawczyk, H., Bellare, M. and Canetti, R. "HMAC: Keyed-Hashing for + Message Authentication", RFC 2104, February 1997. + ([uri http://www.rfc-editor.org/rfc/rfc2104.txt]) + +[list_end] + +[vset CATEGORY md4] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/md4/md4.tcl b/tcllib/modules/md4/md4.tcl new file mode 100644 index 0000000..3138d57 --- /dev/null +++ b/tcllib/modules/md4/md4.tcl @@ -0,0 +1,571 @@ +# md4.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# This is a Tcl-only implementation of the MD4 hash algorithm as described in +# RFC 1320 ( http://www.ietf.org/rfc/rfc1320.txt ) +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2; # tcl minimum version +catch {package require md4c 1.0}; # tcllib critcl alternative + +# @mdgen EXCLUDE: md4c.tcl + +namespace eval ::md4 { + variable accel + array set accel {critcl 0 cryptkit 0} + + namespace export md4 hmac MD4Init MD4Update MD4Final + + variable uid + if {![info exists uid]} { + set uid 0 + } +} + +# ------------------------------------------------------------------------- + +# MD4Init - create and initialize an MD4 state variable. This will be +# cleaned up when we call MD4Final +# +proc ::md4::MD4Init {} { + variable uid + variable accel + set token [namespace current]::[incr uid] + upvar #0 $token state + + # RFC1320:3.3 - Initialize MD4 state structure + array set state \ + [list \ + A [expr {0x67452301}] \ + B [expr {0xefcdab89}] \ + C [expr {0x98badcfe}] \ + D [expr {0x10325476}] \ + n 0 i "" ] + if {$accel(cryptkit)} { + cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_MD4 + } + return $token +} + +proc ::md4::MD4Update {token data} { + variable accel + upvar #0 $token state + + if {$accel(critcl)} { + if {[info exists state(md4c)]} { + set state(md4c) [md4c $data $state(md4c)] + } else { + set state(md4c) [md4c $data] + } + return + } elseif {[info exists state(ckctx)]} { + if {[string length $data] > 0} { + cryptkit::cryptEncrypt $state(ckctx) $data + } + return + } + + # Update the state values + incr state(n) [string length $data] + append state(i) $data + + # Calculate the hash for any complete blocks + set len [string length $state(i)] + for {set n 0} {($n + 64) <= $len} {} { + MD4Hash $token [string range $state(i) $n [incr n 64]] + } + + # Adjust the state for the blocks completed. + set state(i) [string range $state(i) $n end] + return +} + +proc ::md4::MD4Final {token} { + upvar #0 $token state + + if {[info exists state(md4c)]} { + set r $state(md4c) + unset state + return $r + } elseif {[info exists state(ckctx)]} { + cryptkit::cryptEncrypt $state(ckctx) "" + cryptkit::cryptGetAttributeString $state(ckctx) \ + CRYPT_CTXINFO_HASHVALUE r 16 + cryptkit::cryptDestroyContext $state(ckctx) + # If nothing was hashed, we get no r variable set! + if {[info exists r]} { + unset state + return $r + } + } + + # RFC1320:3.1 - Padding + # + set len [string length $state(i)] + set pad [expr {56 - ($len % 64)}] + if {$len % 64 > 56} { + incr pad 64 + } + if {$pad == 0} { + incr pad 64 + } + append state(i) [binary format a$pad \x80] + + # RFC1320:3.2 - Append length in bits as little-endian wide int. + append state(i) [binary format ii [expr {8 * $state(n)}] 0] + + # Calculate the hash for the remaining block. + set len [string length $state(i)] + for {set n 0} {($n + 64) <= $len} {} { + MD4Hash $token [string range $state(i) $n [incr n 64]] + } + + # RFC1320:3.5 - Output + set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)] + unset state + return $r +} + +# ------------------------------------------------------------------------- +# HMAC Hashed Message Authentication (RFC 2104) +# +# hmac = H(K xor opad, H(K xor ipad, text)) +# +proc ::md4::HMACInit {K} { + + # Key K is adjusted to be 64 bytes long. If K is larger, then use + # the MD4 digest of K and pad this instead. + set len [string length $K] + if {$len > 64} { + set tok [MD4Init] + MD4Update $tok $K + set K [MD4Final $tok] + set len [string length $K] + } + set pad [expr {64 - $len}] + append K [string repeat \0 $pad] + + # Cacluate the padding buffers. + set Ki {} + set Ko {} + binary scan $K i16 Ks + foreach k $Ks { + append Ki [binary format i [expr {$k ^ 0x36363636}]] + append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]] + } + + set tok [MD4Init] + MD4Update $tok $Ki; # initialize with the inner pad + + # preserve the Ko value for the final stage. + # FRINK: nocheck + set [subst $tok](Ko) $Ko + + return $tok +} + +proc ::md4::HMACUpdate {token data} { + MD4Update $token $data + return +} + +proc ::md4::HMACFinal {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set tok [MD4Init]; # init the outer hashing function + MD4Update $tok $state(Ko); # prepare with the outer pad. + MD4Update $tok [MD4Final $token]; # hash the inner result + return [MD4Final $tok] +} + +# ------------------------------------------------------------------------- + +set ::md4::MD4Hash_body { + variable $token + upvar 0 $token state + + # RFC1320:3.4 - Process Message in 16-Word Blocks + binary scan $msg i* blocks + foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks { + set A $state(A) + set B $state(B) + set C $state(C) + set D $state(D) + + # Round 1 + # Let [abcd k s] denote the operation + # a = (a + F(b,c,d) + X[k]) <<< s. + # Do the following 16 operations. + # [ABCD 0 3] [DABC 1 7] [CDAB 2 11] [BCDA 3 19] + set A [expr {($A + [F $B $C $D] + $X0) <<< 3}] + set D [expr {($D + [F $A $B $C] + $X1) <<< 7}] + set C [expr {($C + [F $D $A $B] + $X2) <<< 11}] + set B [expr {($B + [F $C $D $A] + $X3) <<< 19}] + # [ABCD 4 3] [DABC 5 7] [CDAB 6 11] [BCDA 7 19] + set A [expr {($A + [F $B $C $D] + $X4) <<< 3}] + set D [expr {($D + [F $A $B $C] + $X5) <<< 7}] + set C [expr {($C + [F $D $A $B] + $X6) <<< 11}] + set B [expr {($B + [F $C $D $A] + $X7) <<< 19}] + # [ABCD 8 3] [DABC 9 7] [CDAB 10 11] [BCDA 11 19] + set A [expr {($A + [F $B $C $D] + $X8) <<< 3}] + set D [expr {($D + [F $A $B $C] + $X9) <<< 7}] + set C [expr {($C + [F $D $A $B] + $X10) <<< 11}] + set B [expr {($B + [F $C $D $A] + $X11) <<< 19}] + # [ABCD 12 3] [DABC 13 7] [CDAB 14 11] [BCDA 15 19] + set A [expr {($A + [F $B $C $D] + $X12) <<< 3}] + set D [expr {($D + [F $A $B $C] + $X13) <<< 7}] + set C [expr {($C + [F $D $A $B] + $X14) <<< 11}] + set B [expr {($B + [F $C $D $A] + $X15) <<< 19}] + + # Round 2. + # Let [abcd k s] denote the operation + # a = (a + G(b,c,d) + X[k] + 5A827999) <<< s + # Do the following 16 operations. + # [ABCD 0 3] [DABC 4 5] [CDAB 8 9] [BCDA 12 13] + set A [expr {($A + [G $B $C $D] + $X0 + 0x5a827999) <<< 3}] + set D [expr {($D + [G $A $B $C] + $X4 + 0x5a827999) <<< 5}] + set C [expr {($C + [G $D $A $B] + $X8 + 0x5a827999) <<< 9}] + set B [expr {($B + [G $C $D $A] + $X12 + 0x5a827999) <<< 13}] + # [ABCD 1 3] [DABC 5 5] [CDAB 9 9] [BCDA 13 13] + set A [expr {($A + [G $B $C $D] + $X1 + 0x5a827999) <<< 3}] + set D [expr {($D + [G $A $B $C] + $X5 + 0x5a827999) <<< 5}] + set C [expr {($C + [G $D $A $B] + $X9 + 0x5a827999) <<< 9}] + set B [expr {($B + [G $C $D $A] + $X13 + 0x5a827999) <<< 13}] + # [ABCD 2 3] [DABC 6 5] [CDAB 10 9] [BCDA 14 13] + set A [expr {($A + [G $B $C $D] + $X2 + 0x5a827999) <<< 3}] + set D [expr {($D + [G $A $B $C] + $X6 + 0x5a827999) <<< 5}] + set C [expr {($C + [G $D $A $B] + $X10 + 0x5a827999) <<< 9}] + set B [expr {($B + [G $C $D $A] + $X14 + 0x5a827999) <<< 13}] + # [ABCD 3 3] [DABC 7 5] [CDAB 11 9] [BCDA 15 13] + set A [expr {($A + [G $B $C $D] + $X3 + 0x5a827999) <<< 3}] + set D [expr {($D + [G $A $B $C] + $X7 + 0x5a827999) <<< 5}] + set C [expr {($C + [G $D $A $B] + $X11 + 0x5a827999) <<< 9}] + set B [expr {($B + [G $C $D $A] + $X15 + 0x5a827999) <<< 13}] + + # Round 3. + # Let [abcd k s] denote the operation + # a = (a + H(b,c,d) + X[k] + 6ED9EBA1) <<< s. + # Do the following 16 operations. + # [ABCD 0 3] [DABC 8 9] [CDAB 4 11] [BCDA 12 15] + set A [expr {($A + [H $B $C $D] + $X0 + 0x6ed9eba1) <<< 3}] + set D [expr {($D + [H $A $B $C] + $X8 + 0x6ed9eba1) <<< 9}] + set C [expr {($C + [H $D $A $B] + $X4 + 0x6ed9eba1) <<< 11}] + set B [expr {($B + [H $C $D $A] + $X12 + 0x6ed9eba1) <<< 15}] + # [ABCD 2 3] [DABC 10 9] [CDAB 6 11] [BCDA 14 15] + set A [expr {($A + [H $B $C $D] + $X2 + 0x6ed9eba1) <<< 3}] + set D [expr {($D + [H $A $B $C] + $X10 + 0x6ed9eba1) <<< 9}] + set C [expr {($C + [H $D $A $B] + $X6 + 0x6ed9eba1) <<< 11}] + set B [expr {($B + [H $C $D $A] + $X14 + 0x6ed9eba1) <<< 15}] + # [ABCD 1 3] [DABC 9 9] [CDAB 5 11] [BCDA 13 15] + set A [expr {($A + [H $B $C $D] + $X1 + 0x6ed9eba1) <<< 3}] + set D [expr {($D + [H $A $B $C] + $X9 + 0x6ed9eba1) <<< 9}] + set C [expr {($C + [H $D $A $B] + $X5 + 0x6ed9eba1) <<< 11}] + set B [expr {($B + [H $C $D $A] + $X13 + 0x6ed9eba1) <<< 15}] + # [ABCD 3 3] [DABC 11 9] [CDAB 7 11] [BCDA 15 15] + set A [expr {($A + [H $B $C $D] + $X3 + 0x6ed9eba1) <<< 3}] + set D [expr {($D + [H $A $B $C] + $X11 + 0x6ed9eba1) <<< 9}] + set C [expr {($C + [H $D $A $B] + $X7 + 0x6ed9eba1) <<< 11}] + set B [expr {($B + [H $C $D $A] + $X15 + 0x6ed9eba1) <<< 15}] + + # Then perform the following additions. (That is, increment each + # of the four registers by the value it had before this block + # was started.) + incr state(A) $A + incr state(B) $B + incr state(C) $C + incr state(D) $D + } + + return +} + +proc ::md4::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} +proc ::md4::bytes {v} { + #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v] + format %c%c%c%c \ + [expr {0xFF & $v}] \ + [expr {(0xFF00 & $v) >> 8}] \ + [expr {(0xFF0000 & $v) >> 16}] \ + [expr {((0xFF000000 & $v) >> 24) & 0xFF}] +} + +# 32bit rotate-left +proc ::md4::<<< {v n} { + return [expr {((($v << $n) \ + | (($v >> (32 - $n)) \ + & (0x7FFFFFFF >> (31 - $n))))) \ + & 0xFFFFFFFF}] +} + +# Convert our <<< pseudo-operator into a procedure call. +regsub -all -line \ + {\[expr {(.*) <<< (\d+)}\]} \ + $::md4::MD4Hash_body \ + {[<<< [expr {\1}] \2]} \ + ::md4::MD4Hash_body + +# RFC1320:3.4 - function F +proc ::md4::F {X Y Z} { + return [expr {($X & $Y) | ((~$X) & $Z)}] +} + +# Inline the F function +regsub -all -line \ + {\[F (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md4::MD4Hash_body \ + {( (\1 \& \2) | ((~\1) \& \3) )} \ + ::md4::MD4Hash_body + +# RFC1320:3.4 - function G +proc ::md4::G {X Y Z} { + return [expr {($X & $Y) | ($X & $Z) | ($Y & $Z)}] +} + +# Inline the G function +regsub -all -line \ + {\[G (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md4::MD4Hash_body \ + {((\1 \& \2) | (\1 \& \3) | (\2 \& \3))} \ + ::md4::MD4Hash_body + +# RFC1320:3.4 - function H +proc ::md4::H {X Y Z} { + return [expr {$X ^ $Y ^ $Z}] +} + +# Inline the H function +regsub -all -line \ + {\[H (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md4::MD4Hash_body \ + {(\1 ^ \2 ^ \3)} \ + ::md4::MD4Hash_body + +# Define the MD4 hashing procedure with inline functions. +proc ::md4::MD4Hash {token msg} $::md4::MD4Hash_body +unset ::md4::MD4Hash_body + +# ------------------------------------------------------------------------- + +if {[package provide Trf] != {}} { + interp alias {} ::md4::Hex {} ::hex -mode encode -- +} else { + proc ::md4::Hex {data} { + binary scan $data H* result + return [string toupper $result] + } +} + +# ------------------------------------------------------------------------- + +# LoadAccelerator -- +# +# This package can make use of a number of compiled extensions to +# accelerate the digest computation. This procedure manages the +# use of these extensions within the package. During normal usage +# this should not be called, but the test package manipulates the +# list of enabled accelerators. +# +proc ::md4::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require md4c}]} { + set r [expr {[info commands ::md4::md4c] != {}}] + } + } + cryptkit { + if {![catch {package require cryptkit}]} { + set r [expr {![catch {cryptkit::cryptInit}]}] + } + } + #trf { + # if {![catch {package require Trf}]} { + # set r [expr {![catch {::md4 aa} msg]}] + # } + #} + default { + return -code error "invalid accelerator package:\ + must be one of [join [array names accel] {, }]" + } + } + set accel($name) $r +} + +# ------------------------------------------------------------------------- + +# Description: +# Pop the nth element off a list. Used in options processing. +# +proc ::md4::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 ::md4::Chunk {token channel {chunksize 4096}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + MD4Update $token [read $channel $chunksize] +} + +# ------------------------------------------------------------------------- + +proc ::md4::md4 {args} { + array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -hex { set opts(-hex) 1 } + -file* { set opts(-filename) [Pop args 1] } + -channel { set opts(-channel) [Pop args 1] } + -chunksize { set opts(-chunksize) [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 {$opts(-filename) != {}} { + set opts(-channel) [open $opts(-filename) r] + fconfigure $opts(-channel) -translation binary + } + + if {$opts(-channel) == {}} { + + if {[llength $args] != 1} { + return -code error "wrong # args:\ + should be \"md4 ?-hex? -filename file | string\"" + } + set tok [MD4Init] + MD4Update $tok [lindex $args 0] + set r [MD4Final $tok] + + } else { + + set tok [MD4Init] + # FRINK: nocheck + set [subst $tok](reading) 1 + fileevent $opts(-channel) readable \ + [list [namespace origin Chunk] \ + $tok $opts(-channel) $opts(-chunksize)] + vwait [subst $tok](reading) + set r [MD4Final $tok] + + # If we opened the channel - we should close it too. + if {$opts(-filename) != {}} { + close $opts(-channel) + } + } + + if {$opts(-hex)} { + set r [Hex $r] + } + return $r +} + +# ------------------------------------------------------------------------- + +proc ::md4::hmac {args} { + array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -key { set opts(-key) [Pop args 1] } + -hex { set opts(-hex) 1 } + -file* { set opts(-filename) [Pop args 1] } + -channel { set opts(-channel) [Pop args 1] } + -chunksize { set opts(-chunksize) [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 {![info exists opts(-key)]} { + return -code error "wrong # args:\ + should be \"hmac ?-hex? -key key -filename file | string\"" + } + + if {$opts(-filename) != {}} { + set opts(-channel) [open $opts(-filename) r] + fconfigure $opts(-channel) -translation binary + } + + if {$opts(-channel) == {}} { + + if {[llength $args] != 1} { + return -code error "wrong # args:\ + should be \"hmac ?-hex? -key key -filename file | string\"" + } + set tok [HMACInit $opts(-key)] + HMACUpdate $tok [lindex $args 0] + set r [HMACFinal $tok] + + } else { + + set tok [HMACInit $opts(-key)] + # FRINK: nocheck + set [subst $tok](reading) 1 + fileevent $opts(-channel) readable \ + [list [namespace origin Chunk] \ + $tok $opts(-channel) $opts(-chunksize)] + vwait [subst $tok](reading) + set r [HMACFinal $tok] + + # If we opened the channel - we should close it too. + if {$opts(-filename) != {}} { + close $opts(-channel) + } + } + + if {$opts(-hex)} { + set r [Hex $r] + } + return $r +} + +# ------------------------------------------------------------------------- + +# Try and load a compiled extension to help. +namespace eval ::md4 { + variable e {} + foreach e {critcl cryptkit} { if {[LoadAccelerator $e]} { break } } + unset e +} + +package provide md4 1.0.6 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: + + diff --git a/tcllib/modules/md4/md4.test b/tcllib/modules/md4/md4.test new file mode 100644 index 0000000..f11ec7c --- /dev/null +++ b/tcllib/modules/md4/md4.test @@ -0,0 +1,290 @@ +# md4.test - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# $Id: md4.test,v 1.15 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 md4.tcl md4 +} + +# ------------------------------------------------------------------------- + +if {[::md4::LoadAccelerator critcl]} { + puts "> using critcl" +} +if {[::md4::LoadAccelerator cryptkit]} { + puts "> using cryptkit" +} +puts "> pure Tcl" + +# ------------------------------------------------------------------------- +# Handle multiple implementation testing +# + +array set preserve [array get ::md4::accel] + +proc implementations {} { + variable ::md4::accel + foreach {a v} [array get accel] {if {$v} {lappend r $a}} + lappend r tcl; set r +} + +proc select_implementation {impl} { + variable ::md4::accel + foreach e [array names accel] { set accel($e) 0 } + if {[string compare "tcl" $impl] != 0} { + set accel($impl) 1 + } +} + +proc reset_implementation {} { + variable ::md4::accel + array set accel [array get ::preserve] +} + +# ------------------------------------------------------------------------- + +# The RFC 1320 test vectors +# +set vectors { + 1 {} {31D6CFE0D16AE931B73C59D7E0C089C0} + 2 {a} {BDE52CB31DE33E46245E05FBDBD6FB24} + 3 {abc} {A448017AAF21D8525FC10AE87AA6729D} + 4 {message digest} {D9130A8164549FE818874806E1C7014B} + 5 {abcdefghijklmnopqrstuvwxyz} {D79E1C308AA5BBCDEEA8ED63DF412DA9} + 6 {ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789} + {043F8582F241DB351CE627E153E7F0E4} + 7 {12345678901234567890123456789012345678901234567890123456789012345678901234567890} + {E33B4DDC9C38F2199C3E7B164FCC0536} +} + +foreach impl [implementations] { + select_implementation $impl + foreach {n txt dgst} $vectors { + test md4-$impl-1.$n "md4 RFC test strings ($impl impl)" { + list [catch {::md4::md4 -hex $txt} r] $r + } [list 0 $dgst] + } + reset_implementation +} + +# Block length checks +# these values are generated from the OpenSSL library implementation +# by md4_check.c +# +set vectors { + 0 31D6CFE0D16AE931B73C59D7E0C089C0 + 1 BDE52CB31DE33E46245E05FBDBD6FB24 + 2 0DE97E6BACB92B24D7578FFB8D58F51E + 3 918D7099B77C7A06634C62CCAF5EBAC7 + 4 30FDB877509C742C0EF3D63DDBEC5146 + 5 54485D61C2BF8519C3997D2C17D41B43 + 6 9135D5535D445A5ADC299D227D3BDBFB + 7 EB393983D7223A7271398DA9CD13F13C + 8 23008F046FC579F2D373339EC07F1EF1 + 9 A38217D543726545E70685379586F249 + 10 55AEE4317CF6626378BDD590E1A10009 + 11 528BCA944A4FC5F156765B0C415A0AEA + 12 8F919C346C23B06B46C872BE5F80D919 + 13 EB50153829A34A8DE50ECCEEC7D44BAE + 14 0AF8EB203F383DCF6A9D888DE443572F + 15 C531CB0A83667B164886E6C1538AD95E + 16 877A3D1769C7FA80A74E7BD9D7602EF3 + 17 DF84F880A964489D9832AF34FA58E591 + 18 80E3D8A01982AA1E14994E453D33DD26 + 19 F2F147FB12388BECE57ECA1DCC5ED53F + 20 1D9DB7A8B873E64A5C62727EDF6D4BBD + 21 CBBE5C1D394BB0B081E960FEF4E7CA15 + 22 0641E7CD13C7FA26F6DA39E83CD31252 + 23 76D25193130828ACCF4D771ACB1E51E3 + 24 AB434803006332AB606B8C9D284579C9 + 25 EA31D4CD2D48469501E09C62DA35FDBD + 26 9A374B8B9DD4D3D02AC55036236E7A4D + 27 CC678CD190CBD158E2A111A6A8E6EB4B + 28 DD3D0C638699B8DB7D4776A7BF415394 + 29 AD4914D6703EC452117852FE99D45E83 + 30 D4450595903614027BA328EEFA0EA601 + 31 B439B841FD3BECFF4E2DAC49D19ED7CF + 32 7DFEF9B2EB78B2367246C381C8856478 + 33 B3F634CC931234DEDF1E51B0015914F9 + 34 C9EE7F5964094201EE080B572EF135E0 + 35 E02F85B1A7838B905E90E279F27FEBC8 + 36 1254586BFD14E030CE4086FA961CE782 + 37 E93B0EBE0FE3C688419FAF37511C8F5B + 38 D6D79128936F4B32D01E395AECF29D82 + 39 7A0AC9F4F25A7C47AFA9AA7DF30D3221 + 40 2F195C997AADA83926FE22847CD3B37C + 41 09354A0A378CFDA1FF95A8885D38C4A8 + 42 C2256534BFEAE9FA1EE7E86187BB965A + 43 FE8F4AE6501CA2898981F60DA8C7F6AE + 44 46140F97EFBD88928FF112F5367B526A + 45 9D403D371C315FF969BAADD8623BC8B3 + 46 068D234494F92F646BA378BF505F8C47 + 47 AF7C0BBED49C6211F1FF4B1739E7AC27 + 48 14D946CC28AC58F8C5F210A06C1C6F25 + 49 EB8702358201CDACE81AAA2DB0C6584E + 50 FB2A7C151E17EC3DF8502062D86135E3 + 51 2D52D26552CBC27CB68EB829E35DD24D + 52 38AB80B7C2B45B568488244ADF334410 + 53 BD3ED6F7A3A4DD4705360984A18577E5 + 54 10993F670D6D785F3E87BC46E8DA89DC + 55 C889C81DD86C4D2E025778944EA02881 + 56 D5F9A9E9257077A5F08B0B92F348B0AD + 57 872097E6F78E3B53F890459D03BC6FB7 + 58 277F5F559A60C0AF69EFDA466786FB30 + 59 A70AE7F83D838CCE274D7491AA915028 + 60 8C6B85BECAB240CA5DB17955C4D39782 + 61 672A99BA40462771641359DCC4CB1DDD + 62 5AE7B0C20144BC35483E8D7C16297658 + 63 7EA3DA77432D44C323671097D1348FC8 + 64 52F5076FABD22680234A3FA9F9DC5732 + 65 330E377BF231F3CACFECC2C182FE7E5B + 66 095BA42E17C00F9336F807D8BDAE72A5 + 67 B714FE2E2D4EBC2D801A481FFAE39FA9 + 68 769051239BB45773C87C19F35071178A + 69 49311D7BB7CC3C078F932E873D7769D2 + 70 DF01FC1E5DD0BFC600DB67201C977EFC + 71 09751A7E990FB1D82C0A1293E5F5B3CC + 72 040E619A227C013B5201A9796246D4AE + 73 3470CE6363ED22E5496F138AA7108416 + 74 26A8C2B51DC60D23597CCA9025119030 + 75 E82ACDF62A2512470B9580B53DF18A2B + 76 C5B92B27DA91D2267C23446ECB6A912C + 77 CDE8AF463FF6018AE7B99AC9DE24EA36 + 78 A883A850600DF1EEF28C573E034E7D18 + 79 A7CCE750192AC057036F1B4C5A2605C8 + 80 721A93B051049C47487B06A59ACC7D64 + 81 F28AA8607F27E972E483638794C1C5FF + 82 577AB2592E92823D26788493457AFB35 + 83 157BB5E384BBFD04719CBB1EACBAC84B + 84 66385A9301518DD05B0F565F08A600EA + 85 0B87DD13CDF6541F400FABE41FA5BA78 + 86 A6446864A8BF8D07D57D96DD908EA956 + 87 6979B8ECFE581790AC7CD990E8E0736E + 88 F0E85BD3BA0E224FDC2306C256CD5F3A + 89 60FA15155478D3C8A76E5ABBDB77CFBE + 90 FCFF0A17BD61381B77355CEF66808308 + 91 828C52051A9693A1B54BE9352268955D + 92 53A6B8D4DD7D0770A5F6DC9874E7B88C + 93 00F8653F803627B70EF2E7E1654576C0 + 94 14A4D10648330012FE672B650C196021 + 95 A6A0B64C05FCD2E57D8CBBC59A1A00B7 + 96 DDC02B8E0A315BA8EE08851668A081A9 + 97 4067061356FA1E283EC5F3610E7EACF0 + 98 717D2EF3060CA3208DECAE86F9BDCFD9 + 99 7B625DF18DC2FFF7F5244A4C50915893 + 100 A2A3C7C3EE6088BAD252BFBBAE229BB6 + 101 547401415A107A8147D3BAB71991BE0E + 102 E1C162A95EBE24D4A78DA81FAA6A451B + 103 2A3D6778231DC7EF4AB0D96DB648D128 + 104 89E6CF2B88C9328A4C348A731D317D25 + 105 CF71FEC4631DB55308AD80186B8DCF37 + 106 343CA55FC783302EF9A0B33757E5EF19 + 107 AAD33B8FF079A18D6425470D011B4D31 + 108 357C138B5498B531CB174127FCF14A0F + 109 73B22BE5DBAD1D26BD9071AFEBC35856 + 110 74101D5E7A9321DAD687B4C2AC7E7551 + 111 69DAEFFB60DD1DCFC8A0DDF5ED4DEA4F + 112 CCBF3DFA0FAC8C6E5C2504CF15777E71 + 113 6EE2AD0A2A06E975C2FA8887333DE734 + 114 8A7DEFD65211A52A20CBD989BCB079D7 + 115 650A6088C41B5951EF46B09F8A8F7A16 + 116 F731ACBD40496A63FD33C72BFF4ADC4C + 117 64279E932B0A6CF7FBEBC12969AD85F9 + 118 5257D42AE36DCFC8418FA40600696E16 + 119 E65DD227CCEF97FA1D34D70189120F76 + 120 B03DDBD470B47C013E0C7AB2DDD763DB + 121 E5601AA6994470F918405D745EDE163C + 122 6BAF506A6E6A525E9EF9BBF7E6B4F45B + 123 D312F30D9FFF78E5404F8EAC3F0B665F + 124 A7A1C6286070E9A7AFA4831D2BF7BAFD + 125 941B80ACD86C9D9C3F27380591507DED + 126 85C05A6BB4B2CF906813652C68686361 + 127 9733B046AD770B4E093B35DE4E09E828 + 128 CB4A20A561558E29460190C91DCED59F + 129 2ADCD303C29F93A3EE33A560ECE91CD2 + 130 52B8CE960BB64E4EC2B579D4047B175E + 131 6EF49AAA109B8120004FFCC801218CAF + 132 370ED97ADF490F75693CD5FC73A8E3E0 + 133 54DE78D79AD53DA4CE46F945160B591F + 134 0D9014C7B4A9EDB3D594056E78D25B9D + 135 4AE5F06E7A0AB2B7142583873ACFCCFD + 136 C4CA41E447A27ECEE443370B002B6459 + 137 9A64358C2602DA3F21D2E79B21E94BF1 + 138 5761A624A7BDEDAD64E543BC73213E64 + 139 D301A78CB6959F11E81BD7A3C6BF5BB3 + 140 5D726C762665398737C34803095E91F3 + 141 DB62B01151A01D5E4A00D87F2A48B98A + 142 C310B6E1016ECB9F5A5C5A4B89F17A76 + 143 33C7D6E29F904B27272E75144BE07D18 + 144 835048E983D82FB0FA151BB8B6FA636E + 145 B9FF2575260E2AD08557EEBA52B27CDD + 146 BCCCBCFEAB174BDDB81CC74DD97984F6 + 147 9B98A75EDED6B5AF8C449B75A74C30B3 + 148 5F9F642231152DD8CD5CAA9B5FC59B5D + 149 84D82189C5458F8647D338FD62EF1667 +} + +foreach impl [implementations] { + select_implementation $impl + foreach {n hash} $vectors { + test md4-$impl-2.$n "md4 block size checks: length $n ($impl)" { + list [catch { + ::md4::md4 -hex [string repeat a $n] + } msg] $msg + } [list 0 $hash] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +test md4-3.1 {Check hashing data that begins with hyphen} { + list [catch {::md4::md4 -hex -hello} msg] $msg +} {0 2366A71EF5007E097635894C39E6D649} + +test md4-3.2 {Check hashing data that begins with hyphen} { + list [catch {::md4::md4 -hex -- -hello} msg] $msg +} {0 2366A71EF5007E097635894C39E6D649} + +test md4-3.3 {Check hashing data that begins with hyphen} { + list [catch {::md4::md4 -hex --} msg] $msg +} {0 4C0C5CD6347599F2A7FB4B8135E8BC54} + +test md4-3.4 {Check hashing data that begins with hyphen} { + list [catch {::md4::md4 -hex -- --} msg] $msg +} {0 4C0C5CD6347599F2A7FB4B8135E8BC54} + + +test md4-4.1 {Check hmac data that begins with hyphen} { + list [catch {::md4::hmac -hex -key "" -hello} msg] $msg +} {0 5B3C613872A7EF6B027E108649E586E9} + +test md4-4.2 {Check hmac data that begins with hyphen} { + list [catch {::md4::hmac -hex -key "" -- -hello} msg] $msg +} {0 5B3C613872A7EF6B027E108649E586E9} + +test md4-4.3 {Check hmac data that begins with hyphen} { + list [catch {::md4::hmac -hex -key "" --} msg] $msg +} {0 8CE99298976A960211A6D3FB2EAC8B2D} + +test md4-4.4 {Check hmac data that begins with hyphen} { + list [catch {::md4::hmac -hex -key "" -- --} msg] $msg +} {0 8CE99298976A960211A6D3FB2EAC8B2D} + + +testsuiteCleanup + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/md4/md4_check.c b/tcllib/modules/md4/md4_check.c new file mode 100644 index 0000000..fc24269 --- /dev/null +++ b/tcllib/modules/md4/md4_check.c @@ -0,0 +1,62 @@ +/* md4_check.c Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> + * + * Generate test data to permit comparison of the tcl implementation of MD4 + * against the OpenSSL library implementation. + * + * usage: md4_check + * + * $Id: md4_check.c,v 1.2 2004/01/15 06:36:13 andreas_kupries Exp $ + */ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <openssl/md4.h> + +static const char rcsid[] = +"$Id: md4_check.c,v 1.2 2004/01/15 06:36:13 andreas_kupries Exp $"; + +void +md4(const char *buf, size_t len, unsigned char *res) +{ + MD4_CTX ctx; + MD4_Init(&ctx); + MD4_Update(&ctx, buf, len); + MD4_Final(res, &ctx); +} + +void +dump(unsigned char *data, size_t len) +{ + char buf[80], *p; + size_t cn, n; + + for (cn = 0, p = buf; cn < len; cn++, p += 2) { + n = sprintf(p, "%02X", data[cn]); + } + puts(buf); +} + +int +main(int argc, char *argv[]) +{ + size_t cn; + char buf[256]; + unsigned char r[16]; + + memset(buf, 'a', 256); + + for (cn = 0; cn < 150; cn++) { + md4(buf, cn, r); + printf("%7d ", cn); + dump(r, 16); + } + return 0; +} + +/* + * Local variables: + * mode: c + * indent-tabs-mode: nil + * End: + */ diff --git a/tcllib/modules/md4/md4c.tcl b/tcllib/modules/md4/md4c.tcl new file mode 100644 index 0000000..fa89b61 --- /dev/null +++ b/tcllib/modules/md4/md4c.tcl @@ -0,0 +1,120 @@ +# md4c.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# This provides a C implementation of MD4 using the sample code from RFC1320 +# and wrapping this up in a Tcl package. +# +# The tcl interface code is based upon the md5c code from critcl by JCW. +# +# INSTALLATION +# ------------ +# This package uses critcl (http://wiki.tcl.tk/critcl). To build do: +# critcl -libdir <your-tcl-lib-dir> -pkg md4c md4c +# +# $Id: md4c.tcl,v 1.6 2009/05/06 22:57:50 patthoyts Exp $ + +package require critcl +# @sak notprovided md4c +package provide md4c 1.1.0 + +critcl::cheaders md4.h +critcl::csources md4.c + +namespace eval ::md4 { + + critcl::ccode { + #include <string.h> + #include "md4.h" + + /* + * define a Tcl object type for the MD4 state + */ + static Tcl_ObjType md4_type; + + static void md4_free_rep(Tcl_Obj *obj) + { + MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; + Tcl_Free((char *)ctx); + } + + static void md4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) + { + MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; + dup->internalRep.otherValuePtr = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); + memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(MD4_CTX)); + dup->typePtr = &md4_type; + } + + static void md4_string_rep(Tcl_Obj* obj) + { + unsigned char buf[16]; + Tcl_Obj* temp; + char* str; + MD4_CTX *dup = (MD4_CTX *)obj->internalRep.otherValuePtr; + + MD4Final(buf, dup); + + /* convert via a byte array to properly handle null bytes */ + temp = Tcl_NewByteArrayObj(buf, sizeof buf); + Tcl_IncrRefCount(temp); + + str = Tcl_GetStringFromObj(temp, &obj->length); + obj->bytes = Tcl_Alloc(obj->length + 1); + memcpy(obj->bytes, str, obj->length + 1); + + Tcl_DecrRefCount(temp); + } + + static int md4_from_any(Tcl_Interp* interp, Tcl_Obj* obj) + { + /* assert(0); */ + return TCL_ERROR; + } + + static Tcl_ObjType md4_type = { + "md4c", md4_free_rep, md4_dup_rep, md4_string_rep, md4_from_any + }; + + } + + critcl::ccommand md4c {dummy interp objc objv} { + MD4_CTX *ctx; + unsigned char *data; + int size; + Tcl_Obj *obj; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data ?context?"); + return TCL_ERROR; + } + + if (objc == 3) { + if (objv[2]->typePtr != &md4_type + && md4_from_any(interp, objv[2]) != TCL_OK) { + return TCL_ERROR; + } + obj = objv[2]; + if (Tcl_IsShared(obj)) { + obj = Tcl_DuplicateObj(obj); + } + } else { + ctx = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); + MD4Init(ctx); + obj = Tcl_NewObj(); + Tcl_InvalidateStringRep(obj); + obj->internalRep.otherValuePtr = ctx; + obj->typePtr = &md4_type; + } + + ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; + data = Tcl_GetByteArrayFromObj(objv[1], &size); + MD4Update(ctx, data, size); + Tcl_SetObjResult(interp, obj); + + return TCL_OK; + } +} + +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/md4/pkgIndex.tcl b/tcllib/modules/md4/pkgIndex.tcl new file mode 100644 index 0000000..dbbe004 --- /dev/null +++ b/tcllib/modules/md4/pkgIndex.tcl @@ -0,0 +1,3 @@ +# This package has been tested with tcl 8.2.3 and above. +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded md4 1.0.6 [list source [file join $dir md4.tcl]] |