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/md5 | |
| 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/md5')
| -rw-r--r-- | tcllib/modules/md5/ChangeLog | 308 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5.c | 293 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5.h | 66 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5.man | 174 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5.tcl | 454 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5.test | 90 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5c.tcl | 148 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5v1.bench | 47 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5v2.bench | 47 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5x.tcl | 713 | ||||
| -rw-r--r-- | tcllib/modules/md5/md5x.test | 216 | ||||
| -rw-r--r-- | tcllib/modules/md5/pkgIndex.tcl | 3 |
12 files changed, 2559 insertions, 0 deletions
diff --git a/tcllib/modules/md5/ChangeLog b/tcllib/modules/md5/ChangeLog new file mode 100644 index 0000000..c19a9c6 --- /dev/null +++ b/tcllib/modules/md5/ChangeLog @@ -0,0 +1,308 @@ +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> + + * md5c.tcl: The md5c command was leaking a Tcl_Obj on each call + due to having one too many ref counts. Also use Tcl_Alloc rather + than malloc. + +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-07-04 Andreas Kupries <andreask@activestate.com> + + * md5.man: Fixed creative writing problem reported by + * md5x.tcl: Julian Noble <juliannoble@users.sourceforge.net>, + * pkgIndex.tcl: as [Bug 2010798]. Bumped version to 2.0.7. + +2008-04-29 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Clean up the MD5Hash_body once the proc defined. + +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> + + * md5.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> + + * md5.man: Bumped version to 2.0.5 + * md5x.tcl: + * pkgIndex.tcl: + +2006-01-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5x.test: Fixed usage of duplicate test names. + +2006-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.test: More boilerplate simplified via use of test support. + * md5x.test: + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.test: Hooked into the new common test support code. + * md5x.test: + +2005-10-24 Andreas Kupries <andreask@activestate.com> + + * md5v1.bench: New file. Basic benchmarks for MD5 hashes. + * md5v2.bench: + +2005-10-17 Andreas Kupries <andreask@activestate.com> + + * md5x.tcl: Trivial comment typo fix. + +2005-10-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Performance fix for tcl8.5 integers. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-02-24 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5.tcl: Arranged to run all available implementations in + * md5.test: the tests. + +2005-02-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * pkgIndex.tcl: Incremented version to 2.0.4 + * md5x.tcl: Rationalised the handling of accelerator packages and + * md5x.test: added support for use of cryptkit. Updated the man + * md5.man: page to note the available accelerators. + +2005-02-20 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.test: Added the RFC 2202 HMAC-MD5 test vectors. + +2005-02-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Avoid raising an error if the string to be hashed + * pkgIndex.tcl: begins with a hyphen. Use '--' as an _optional_ + * md5.mac: end-of-args marker. + * md5x.test: Added tests. + +2004-12-02 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Replaced use of memchan null channel with the systems + NUL device (NUL or /dev/null). This avoids problems with clashing + names when memchan gets included. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-07-01 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Try and fix up the use of Trf with Memchan for the + new-style md5 package. Needs fixed recent versions of both + packages. + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5x.tcl: Updated version number to sync with 1.6.1 + * md5.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> + + * md5x.tcl: Rel. engineering. Updated version number + * md5.man: of md5 v2 to reflect its changes, to 2.0.1. + * 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> + + * md5x.tcl: Rel. engineering. Updated version number + * md5.man: of md5 v2 to reflect its changes, to 2.0.1. + * pkgIndex.tcl: + +2004-02-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5x.tcl: Added -- to end options if using Trf's hex in case the + hash begins with a - character (possible). Streamlined the <<< + proc. + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2004-02-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5x.test: Heh. What a surprise. The testsuite uses a command to + generate the proper error message based on the version of Tcl, + and what does md5 v2 ? It generates its own messages, and they + are always in 8.4+ format. Hnn. Fixed the testsuite. + +2003-07-27 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5.man: Updated the manual page for md5 2.0 + +2003-07-26 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5c.tcl: Brought in the critcl implementation of MD5 + * md5.c: originally by Jean-Claude Wippler <jcw@equi4.com> + * md5.h: with code from RFC 1321. + + * md5x.tcl: Version 2 md5 module. This is based upon the MD4 module + * md5x.test: code and permits incremental updates into the hash. + This version will use the critcl code if available. + + === VERSION INCOMPATABILITY === + + md5 1 returns data as a hex representation. + md5 2 returns the data as a binary representation. If you want the + hex rep, provide the -hex option to the md5 command. + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * md5.tcl: + * md5.man: + * pkgIndex.tcl: Set version of the package to to 1.4.3. + +2003-02-05 David N. Welton <davidw@dedasys.com> + + * md5.tcl (::md5::time): Used lindex instead of regexp to fish the + number out of 'time' results. Not really a performance win here, + but it's good style. + +2003-01-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * md5.tcl: Handle cases where Trf is available but the md5 command + is not callable (like missing crypt.dll or libmd5crypt). + +2002-03-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.man: Fixed formatting errors in the doctools manpage. + +2002-02-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Version up to 1.4.2 to differentiate development from the + version in the tcllib 1.2 release. + + * md5.tcl: Adding -- to hex/md5 commands to prevent + misinterpretation of data if starting with -. + +2001-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.n: + * md5.tcl: + * pkgIndex.tcl: Version up to 1.4.1 + +2001-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.test: Fixed broken error messages for 8.4. Using + [tcltest::getErrorMessage] now to get the correct message for + all versions of the core. Bug [440046] reported by Larry Virden. + +2001-07-10 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.tcl: Frink 2.2 run, fixed dubious code. + +2001-07-03 Miguel Sofer <mig@utdt.edu> + + * md5.tcl: some more inlining, 10% faster + +2001-06-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.tcl: Fixed dubious code reported by frink. + +2001-06-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.n: Fixed nroff trouble. + +2001-06-02 Miguel Sofer <mig@utdt.edu> + + * md5.tcl: modified the pure Tcl code to run almost 5 times + faster, by inlining (via regsub) function calls and using local + variables instead of arrays. + + Bumped version number to 1.4 + +2001-04-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * md5.test: Added tests of "md5::hmac". This allows us to test the + two different implementations against each other. + + Note: The test file will now print which of the two variants + (pure Tcl vs. Trf based) is active and under test. + + * md5.tcl: Added code to create a soft dependency on Trf. In other + words, if Trf is present it will be loaded and used to speed up + operations. Without Trf the original code in pure Tcl will be + used. Note that the presence of Trf allows us to optimize the + command "md5::hmac" too. + +2001-04-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * New module, 'md5'. The code Don Libes's <libes@nist.gov> + md5pure, extended with a soft dependency on Trf to allow higher + speed if the environment is right. diff --git a/tcllib/modules/md5/md5.c b/tcllib/modules/md5/md5.c new file mode 100644 index 0000000..0a8cafe --- /dev/null +++ b/tcllib/modules/md5/md5.c @@ -0,0 +1,293 @@ +/* + *********************************************************************** + ** md5.c -- the source code for MD5 routines ** + ** RSA Data Security, Inc. MD5 Message-Digest Algorithm ** + ** Created: 2/17/90 RLR ** + ** Revised: 1/91 SRD,AJ,BSK,JT Reference C Version ** + *********************************************************************** + */ + +/* + * Edited 7 May 93 by CP to change the interface to match that + * of the MD5 routines in RSAREF. Due to this alteration, this + * code is "derived from the RSA Data Security, Inc. MD5 Message- + * Digest Algorithm". (See below.) + */ + +/* + *********************************************************************** + ** Copyright (C) 1990, 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. MD5 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. MD5 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 "md5.h" + +/* + *********************************************************************** + ** Message-digest routines: ** + ** To form the message digest for a message M ** + ** (1) Initialize a context buffer mdContext using MD5Init ** + ** (2) Call MD5Update on mdContext and M ** + ** (3) Call MD5Final on mdContext ** + ** The message digest is now in the bugffer passed to MD5Final ** + *********************************************************************** + */ + +static unsigned char PADDING[64] = { + 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 +}; + +/* F, G, H and I are basic MD5 functions */ +#define F(x, y, z) (((x) & (y)) | ((~x) & (z))) +#define G(x, y, z) (((x) & (z)) | ((y) & (~z))) +#define H(x, y, z) ((x) ^ (y) ^ (z)) +#define I(x, y, z) ((y) ^ ((x) | (~z))) + +/* ROTATE_LEFT rotates x left n bits */ +#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n)))) + +/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4 */ +/* Rotation is separate from addition to prevent recomputation */ +#define FF(a, b, c, d, x, s, ac) \ + {(a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ + } +#define GG(a, b, c, d, x, s, ac) \ + {(a) += G ((b), (c), (d)) + (x) + (UINT4)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ + } +#define HH(a, b, c, d, x, s, ac) \ + {(a) += H ((b), (c), (d)) + (x) + (UINT4)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ + } +#define II(a, b, c, d, x, s, ac) \ + {(a) += I ((b), (c), (d)) + (x) + (UINT4)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ + } + +/* The routine MD5Init initializes the message-digest context + mdContext. All fields are set to zero. + */ +void MD5Init (mdContext) +MD5_CTX *mdContext; +{ + mdContext->i[0] = mdContext->i[1] = (UINT4)0; + + /* Load magic initialization constants. + */ + mdContext->buf[0] = (UINT4)0x67452301L; + mdContext->buf[1] = (UINT4)0xefcdab89L; + mdContext->buf[2] = (UINT4)0x98badcfeL; + mdContext->buf[3] = (UINT4)0x10325476L; +} + +/* The routine MD5Update updates the message-digest context to + account for the presence of each of the characters inBuf[0..inLen-1] + in the message whose digest is being computed. + */ +void MD5Update (mdContext, inBuf, inLen) +register MD5_CTX *mdContext; unsigned char *inBuf; + unsigned int inLen; +{ + register int i, ii; + int mdi; + UINT4 in[16]; + + /* compute number of bytes mod 64 */ + mdi = (int)((mdContext->i[0] >> 3) & 0x3F); + + /* update number of bits */ + if ((mdContext->i[0] + ((UINT4)inLen << 3)) < mdContext->i[0]) + mdContext->i[1]++; + mdContext->i[0] += ((UINT4)inLen << 3); + mdContext->i[1] += ((UINT4)inLen >> 29); + + while (inLen--) { + /* add new character to buffer, increment mdi */ + mdContext->in[mdi++] = *inBuf++; + + /* transform if necessary */ + if (mdi == 0x40) { + for (i = 0, ii = 0; i < 16; i++, ii += 4) + in[i] = (((UINT4)mdContext->in[ii+3]) << 24) | + (((UINT4)mdContext->in[ii+2]) << 16) | + (((UINT4)mdContext->in[ii+1]) << 8) | + ((UINT4)mdContext->in[ii]); + Transform (mdContext->buf, in); + mdi = 0; + } + } +} + +/* The routine MD5Final terminates the message-digest computation and + ends with the desired message digest in mdContext->digest[0...15]. + */ +void MD5Final (digest, mdContext) +unsigned char digest[16]; MD5_CTX *mdContext; +{ + UINT4 in[16]; + int mdi; + unsigned int i, ii; + unsigned int padLen; + + /* save number of bits */ + in[14] = mdContext->i[0]; + in[15] = mdContext->i[1]; + + /* compute number of bytes mod 64 */ + mdi = (int)((mdContext->i[0] >> 3) & 0x3F); + + /* pad out to 56 mod 64 */ + padLen = (mdi < 56) ? (56 - mdi) : (120 - mdi); + MD5Update (mdContext, PADDING, padLen); + + /* append length in bits and transform */ + for (i = 0, ii = 0; i < 14; i++, ii += 4) + in[i] = (((UINT4)mdContext->in[ii+3]) << 24) | + (((UINT4)mdContext->in[ii+2]) << 16) | + (((UINT4)mdContext->in[ii+1]) << 8) | + ((UINT4)mdContext->in[ii]); + Transform (mdContext->buf, in); + + /* store buffer in digest */ + for (i = 0, ii = 0; i < 4; i++, ii += 4) { + digest[ii] = (unsigned char) (mdContext->buf[i] & 0xFF); + digest[ii+1] = (unsigned char)((mdContext->buf[i] >> 8) & 0xFF); + digest[ii+2] = (unsigned char)((mdContext->buf[i] >> 16) & 0xFF); + digest[ii+3] = (unsigned char)((mdContext->buf[i] >> 24) & 0xFF); + } +} + +/* Basic MD5 step. Transforms buf based on in. Note that if the Mysterious + Constants are arranged backwards in little-endian order and decrypted with + the DES they produce OCCULT MESSAGES! + */ +void Transform(buf, in) +register UINT4 *buf; +register UINT4 *in; +{ + register UINT4 a = buf[0], b = buf[1], c = buf[2], d = buf[3]; + + /* Round 1 */ +#define S11 7 +#define S12 12 +#define S13 17 +#define S14 22 + FF ( a, b, c, d, in[ 0], S11, 0xD76AA478L); /* 1 */ + FF ( d, a, b, c, in[ 1], S12, 0xE8C7B756L); /* 2 */ + FF ( c, d, a, b, in[ 2], S13, 0x242070DBL); /* 3 */ + FF ( b, c, d, a, in[ 3], S14, 0xC1BDCEEEL); /* 4 */ + FF ( a, b, c, d, in[ 4], S11, 0xF57C0FAFL); /* 5 */ + FF ( d, a, b, c, in[ 5], S12, 0x4787C62AL); /* 6 */ + FF ( c, d, a, b, in[ 6], S13, 0xA8304613L); /* 7 */ + FF ( b, c, d, a, in[ 7], S14, 0xFD469501L); /* 8 */ + FF ( a, b, c, d, in[ 8], S11, 0x698098D8L); /* 9 */ + FF ( d, a, b, c, in[ 9], S12, 0x8B44F7AFL); /* 10 */ + FF ( c, d, a, b, in[10], S13, 0xFFFF5BB1L); /* 11 */ + FF ( b, c, d, a, in[11], S14, 0x895CD7BEL); /* 12 */ + FF ( a, b, c, d, in[12], S11, 0x6B901122L); /* 13 */ + FF ( d, a, b, c, in[13], S12, 0xFD987193L); /* 14 */ + FF ( c, d, a, b, in[14], S13, 0xA679438EL); /* 15 */ + FF ( b, c, d, a, in[15], S14, 0x49B40821L); /* 16 */ + + /* Round 2 */ +#define S21 5 +#define S22 9 +#define S23 14 +#define S24 20 + GG ( a, b, c, d, in[ 1], S21, 0xF61E2562L); /* 17 */ + GG ( d, a, b, c, in[ 6], S22, 0xC040B340L); /* 18 */ + GG ( c, d, a, b, in[11], S23, 0x265E5A51L); /* 19 */ + GG ( b, c, d, a, in[ 0], S24, 0xE9B6C7AAL); /* 20 */ + GG ( a, b, c, d, in[ 5], S21, 0xD62F105DL); /* 21 */ + GG ( d, a, b, c, in[10], S22, 0x02441453L); /* 22 */ + GG ( c, d, a, b, in[15], S23, 0xD8A1E681L); /* 23 */ + GG ( b, c, d, a, in[ 4], S24, 0xE7D3FBC8L); /* 24 */ + GG ( a, b, c, d, in[ 9], S21, 0x21E1CDE6L); /* 25 */ + GG ( d, a, b, c, in[14], S22, 0xC33707D6L); /* 26 */ + GG ( c, d, a, b, in[ 3], S23, 0xF4D50D87L); /* 27 */ + GG ( b, c, d, a, in[ 8], S24, 0x455A14EDL); /* 28 */ + GG ( a, b, c, d, in[13], S21, 0xA9E3E905L); /* 29 */ + GG ( d, a, b, c, in[ 2], S22, 0xFCEFA3F8L); /* 30 */ + GG ( c, d, a, b, in[ 7], S23, 0x676F02D9L); /* 31 */ + GG ( b, c, d, a, in[12], S24, 0x8D2A4C8AL); /* 32 */ + + /* Round 3 */ +#define S31 4 +#define S32 11 +#define S33 16 +#define S34 23 + HH ( a, b, c, d, in[ 5], S31, 0xFFFA3942L); /* 33 */ + HH ( d, a, b, c, in[ 8], S32, 0x8771F681L); /* 34 */ + HH ( c, d, a, b, in[11], S33, 0x6D9D6122L); /* 35 */ + HH ( b, c, d, a, in[14], S34, 0xFDE5380CL); /* 36 */ + HH ( a, b, c, d, in[ 1], S31, 0xA4BEEA44L); /* 37 */ + HH ( d, a, b, c, in[ 4], S32, 0x4BDECFA9L); /* 38 */ + HH ( c, d, a, b, in[ 7], S33, 0xF6BB4B60L); /* 39 */ + HH ( b, c, d, a, in[10], S34, 0xBEBFBC70L); /* 40 */ + HH ( a, b, c, d, in[13], S31, 0x289B7EC6L); /* 41 */ + HH ( d, a, b, c, in[ 0], S32, 0xEAA127FAL); /* 42 */ + HH ( c, d, a, b, in[ 3], S33, 0xD4EF3085L); /* 43 */ + HH ( b, c, d, a, in[ 6], S34, 0x04881D05L); /* 44 */ + HH ( a, b, c, d, in[ 9], S31, 0xD9D4D039L); /* 45 */ + HH ( d, a, b, c, in[12], S32, 0xE6DB99E5L); /* 46 */ + HH ( c, d, a, b, in[15], S33, 0x1FA27CF8L); /* 47 */ + HH ( b, c, d, a, in[ 2], S34, 0xC4AC5665L); /* 48 */ + + /* Round 4 */ +#define S41 6 +#define S42 10 +#define S43 15 +#define S44 21 + II ( a, b, c, d, in[ 0], S41, 0xF4292244L); /* 49 */ + II ( d, a, b, c, in[ 7], S42, 0x432AFF97L); /* 50 */ + II ( c, d, a, b, in[14], S43, 0xAB9423A7L); /* 51 */ + II ( b, c, d, a, in[ 5], S44, 0xFC93A039L); /* 52 */ + II ( a, b, c, d, in[12], S41, 0x655B59C3L); /* 53 */ + II ( d, a, b, c, in[ 3], S42, 0x8F0CCC92L); /* 54 */ + II ( c, d, a, b, in[10], S43, 0xFFEFF47DL); /* 55 */ + II ( b, c, d, a, in[ 1], S44, 0x85845DD1L); /* 56 */ + II ( a, b, c, d, in[ 8], S41, 0x6FA87E4FL); /* 57 */ + II ( d, a, b, c, in[15], S42, 0xFE2CE6E0L); /* 58 */ + II ( c, d, a, b, in[ 6], S43, 0xA3014314L); /* 59 */ + II ( b, c, d, a, in[13], S44, 0x4E0811A1L); /* 60 */ + II ( a, b, c, d, in[ 4], S41, 0xF7537E82L); /* 61 */ + II ( d, a, b, c, in[11], S42, 0xBD3AF235L); /* 62 */ + II ( c, d, a, b, in[ 2], S43, 0x2AD7D2BBL); /* 63 */ + II ( b, c, d, a, in[ 9], S44, 0xEB86D391L); /* 64 */ + + buf[0] += a; + buf[1] += b; + buf[2] += c; + buf[3] += d; +} + diff --git a/tcllib/modules/md5/md5.h b/tcllib/modules/md5/md5.h new file mode 100644 index 0000000..5e116a5 --- /dev/null +++ b/tcllib/modules/md5/md5.h @@ -0,0 +1,66 @@ +#ifndef MD5_H +#define MD5_H + +/* + *********************************************************************** + ** md5.h -- header file for implementation of MD5 ** + ** RSA Data Security, Inc. MD5 Message-Digest Algorithm ** + ** Created: 2/17/90 RLR ** + ** Revised: 12/27/90 SRD,AJ,BSK,JT Reference C version ** + ** Revised (for MD5): RLR 4/27/91 ** + ** -- G modified to have y&~z instead of y&z ** + ** -- FF, GG, HH modified to add in last register done ** + ** -- Access pattern: round 2 works mod 5, round 3 works mod 3 ** + ** -- distinct additive constant for each step ** + ** -- round 4 added, working mod 7 ** + *********************************************************************** + */ + +/* + * Edited 7 May 93 by CP to change the interface to match that + * of the MD5 routines in RSAREF. Due to this alteration, this + * code is "derived from the RSA Data Security, Inc. MD5 Message- + * Digest Algorithm". (See below.) Also added argument names + * to the prototypes. + */ + +/* + *********************************************************************** + ** Copyright (C) 1990, 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. MD5 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. MD5 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. ** + *********************************************************************** + */ + +/* typedef a 32-bit type */ +typedef unsigned int UINT4; + +/* Data structure for MD5 (Message-Digest) computation */ +typedef struct { + UINT4 buf[4]; /* scratch buffer */ + UINT4 i[2]; /* number of _bits_ handled mod 2^64 */ + unsigned char in[64]; /* input buffer */ +} MD5_CTX; + +void MD5Init (MD5_CTX *mdContext); +void MD5Update (MD5_CTX *mdContext, unsigned char *buf, unsigned int len); +void MD5Final (unsigned char digest[16], MD5_CTX *mdContext); +void Transform (UINT4 *buf, UINT4 *in); + +#endif diff --git a/tcllib/modules/md5/md5.man b/tcllib/modules/md5/md5.man new file mode 100644 index 0000000..327aaa4 --- /dev/null +++ b/tcllib/modules/md5/md5.man @@ -0,0 +1,174 @@ +[manpage_begin md5 n 2.0.7] +[see_also md4] +[see_also sha1] +[keywords hashing] +[keywords md5] +[keywords message-digest] +[keywords {rfc 1320}] +[keywords {rfc 1321}] +[keywords {rfc 2104}] +[keywords security] +[moddesc {MD5 Message-Digest Algorithm}] +[copyright {2003, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[titledesc {MD5 Message-Digest Algorithm}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require md5 [opt 2.0.7]] +[description] +[para] + +This package is an implementation in Tcl of the MD5 message-digest +algorithm as described in RFC 1321 (1). This algorithm takes +an arbitrary quantity of data and generates a 128-bit message digest +from the input. The MD5 algorithm is related to the MD4 algorithm (2) +but has been strengthened against certain types of potential +attack. MD5 should be used in preference to MD4 for new applications. + +[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 you have either +[package cryptkit] or [package Trf] then either of these can be used to +accelerate the digest computation. If no suitable compiled package is +available then the pure-Tcl implementation wil be used. The +programming interface remains the same in all cases. + +[para] + +[emph "Note"] the previous version of this package always returned a +hex encoded string. This has been changed to simplify the programming +interface and to make this version more compatible with other +implementations. To obtain the previous usage, either explicitly +specify package version 1 or use the [arg "-hex"] option to the +[cmd "md5"] command. + +[section {COMMANDS}] + +[list_begin definitions] + +[call [cmd "::md5::md5"] \ + [opt "[arg -hex]"] \ + [lb] [arg "-channel channel"] | \ + [arg "-file filename"] | [arg "string"] [rb]] + +Calculate the MD5 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 [cmd "md5"] 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 "::md5::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 MD5 +digest algorithm. HMACs are described in RFC 2104 (3) and provide an MD5 +digest that includes a key. All options other than [arg -key] are as +for the [cmd "::md5::md5"] command. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +For the programmer, the MD5 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 MD5 hash operates on a token (equivalent to the +bucket). You call [cmd "MD5Init"] to obtain a token and then call +[cmd "MD5Update"] as many times as required to add data to the hash. To +release any resources and obtain the hash value, you then call +[cmd "MD5Final"]. An equivalent set of functions gives you a keyed digest +(HMAC). + +[list_begin definitions] + +[call [cmd "::md5::MD5Init"]] + +Begins a new MD5 hash. Returns a token ID that must be used for the +remaining functions. + +[call [cmd "::md5::MD5Update"] [arg "token"] [arg "data"]] + +Add data to the hash identified by token. Calling +[emph {MD5Update $token "abcd"}] is equivalent to calling +[emph {MD5Update $token "ab"}] followed by +[emph {MD5Update $token "cb"}]. See [sectref {EXAMPLES}]. + +[call [cmd "::md5::MD5Final"] [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 MD5 +digest value. + +[call [cmd "::md5::HMACInit"] [arg "key"]] + +This is equivalent to the [cmd "::md5::MD5Init"] command except that +it requires the key that will be included in the HMAC. + +[call [cmd "::md5::HMACUpdate"] [arg "token"] [arg "data"]] +[call [cmd "::md5::HMACFinal"] [arg "token"]] + +These commands are identical to the MD5 equivalent commands. + +[list_end] + +[section {EXAMPLES}] + +[example { +% md5::md5 -hex "Tcl does MD5" +8AAC1EE01E20BB347104FABB90310433 +}] + +[example { +% md5::hmac -hex -key Sekret "Tcl does MD5" +35BBA244FD56D3EDF5F3C47474DACB5D +}] + +[example { +% set tok [md5::MD5Init] +::md5::1 +% md5::MD5Update $tok "Tcl " +% md5::MD5Update $tok "does " +% md5::MD5Update $tok "MD5" +% md5::Hex [md5::MD5Final $tok] +8AAC1EE01E20BB347104FABB90310433 +}] + +[section {REFERENCES}] + +[list_begin enumerated] + +[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] + Rivest, R., "The MD4 Message Digest Algorithm", RFC 1320, MIT, + April 1992. ([uri http://www.rfc-editor.org/rfc/rfc1320.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 md5] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/md5/md5.tcl b/tcllib/modules/md5/md5.tcl new file mode 100644 index 0000000..418c782 --- /dev/null +++ b/tcllib/modules/md5/md5.tcl @@ -0,0 +1,454 @@ +################################################## +# +# md5.tcl - MD5 in Tcl +# Author: Don Libes <libes@nist.gov>, July 1999 +# Version 1.2.0 +# +# MD5 defined by RFC 1321, "The MD5 Message-Digest Algorithm" +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" +# +# Most of the comments below come right out of RFC 1321; That's why +# they have such peculiar numbers. In addition, I have retained +# original syntax, bugs in documentation (yes, really), etc. from the +# RFC. All remaining bugs are mine. +# +# HMAC implementation by D. J. Hagberg <dhagberg@millibits.com> and +# is based on C code in RFC 2104. +# +# For more info, see: http://expect.nist.gov/md5pure +# +# - Don +# +# Modified by Miguel Sofer to use inlines and simple variables +################################################## + +# @mdgen EXCLUDE: md5c.tcl + +package require Tcl 8.2 +namespace eval ::md5 { +} + +if {![catch {package require Trf 2.0}] && ![catch {::md5 -- test}]} { + # Trf is available, so implement the functionality provided here + # in terms of calls to Trf for speed. + + proc ::md5::md5 {msg} { + string tolower [::hex -mode encode -- [::md5 -- $msg]] + } + + # hmac: hash for message authentication + + # MD5 of Trf and MD5 as defined by this package have slightly + # different results. Trf returns the digest in binary, here we get + # it as hex-string. In the computation of the HMAC the latter + # requires back conversion into binary in some places. With Trf we + # can use omit these. + + proc ::md5::hmac {key text} { + # if key is longer than 64 bytes, reset it to MD5(key). If shorter, + # pad it out with null (\x00) chars. + set keyLen [string length $key] + if {$keyLen > 64} { + #old: set key [binary format H32 [md5 $key]] + set key [::md5 -- $key] + set keyLen [string length $key] + } + + # ensure the key is padded out to 64 chars with nulls. + set padLen [expr {64 - $keyLen}] + append key [binary format "a$padLen" {}] + + # Split apart the key into a list of 16 little-endian words + binary scan $key i16 blocks + + # XOR key with ipad and opad values + set k_ipad {} + set k_opad {} + foreach i $blocks { + append k_ipad [binary format i [expr {$i ^ 0x36363636}]] + append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]] + } + + # Perform inner md5, appending its results to the outer key + append k_ipad $text + #old: append k_opad [binary format H* [md5 $k_ipad]] + append k_opad [::md5 -- $k_ipad] + + # Perform outer md5 + #old: md5 $k_opad + string tolower [::hex -mode encode -- [::md5 -- $k_opad]] + } + +} else { + # Without Trf use the all-tcl implementation by Don Libes. + + # T will be inlined after the definition of md5body + + # test md5 + # + # This proc is not necessary during runtime and may be omitted if you + # are simply inserting this file into a production program. + # + proc ::md5::test {} { + foreach {msg expected} { + "" + "d41d8cd98f00b204e9800998ecf8427e" + "a" + "0cc175b9c0f1b6a831c399e269772661" + "abc" + "900150983cd24fb0d6963f7d28e17f72" + "message digest" + "f96b697d7cb7938d525a2f31aaf161d0" + "abcdefghijklmnopqrstuvwxyz" + "c3fcd3d76192e4007dfb496cca67e13b" + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "d174ab98d277d9f5a5611c2c9f419d9f" + "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "57edf4a22be3c955ac49da2e2107b67a" + } { + puts "testing: md5 \"$msg\"" + set computed [md5 $msg] + puts "expected: $expected" + puts "computed: $computed" + if {0 != [string compare $computed $expected]} { + puts "FAILED" + } else { + puts "SUCCEEDED" + } + } + } + + # time md5 + # + # This proc is not necessary during runtime and may be omitted if you + # are simply inserting this file into a production program. + # + proc ::md5::time {} { + foreach len {10 50 100 500 1000 5000 10000} { + set time [::time {md5 [format %$len.0s ""]} 100] + set msec [lindex $time 0] + puts "input length $len: [expr {$msec/1000}] milliseconds per interation" + } + } + + # + # We just define the body of md5pure::md5 here; later we + # regsub to inline a few function calls for speed + # + + set ::md5::md5body { + + # + # 3.1 Step 1. Append Padding Bits + # + + set msgLen [string length $msg] + + set padLen [expr {56 - $msgLen%64}] + if {$msgLen % 64 > 56} { + incr padLen 64 + } + + # pad even if no padding required + if {$padLen == 0} { + incr padLen 64 + } + + # append single 1b followed by 0b's + append msg [binary format "a$padLen" \200] + + # + # 3.2 Step 2. Append Length + # + + # RFC doesn't say whether to use little- or big-endian + # code demonstrates little-endian + # This step limits our input to size 2^32b or 2^24B + append msg [binary format "i1i1" [expr {8*$msgLen}] 0] + + # + # 3.3 Step 3. Initialize MD Buffer + # + + set A [expr 0x67452301] + set B [expr 0xefcdab89] + set C [expr 0x98badcfe] + set D [expr 0x10325476] + + # + # 3.4 Step 4. Process Message in 16-Word Blocks + # + + # process each 16-word block + # RFC doesn't say whether to use little- or big-endian + # code says little-endian + binary scan $msg i* blocks + + # loop over the message taking 16 blocks at a time + + foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks { + + # Save A as AA, B as BB, C as CC, and D as DD. + set AA $A + set BB $B + set CC $C + set DD $D + + # Round 1. + # Let [abcd k s i] denote the operation + # a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s). + # [ABCD 0 7 1] [DABC 1 12 2] [CDAB 2 17 3] [BCDA 3 22 4] + set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X0 + $T01}] 7]}] + set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X1 + $T02}] 12]}] + set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X2 + $T03}] 17]}] + set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X3 + $T04}] 22]}] + # [ABCD 4 7 5] [DABC 5 12 6] [CDAB 6 17 7] [BCDA 7 22 8] + set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X4 + $T05}] 7]}] + set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X5 + $T06}] 12]}] + set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X6 + $T07}] 17]}] + set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X7 + $T08}] 22]}] + # [ABCD 8 7 9] [DABC 9 12 10] [CDAB 10 17 11] [BCDA 11 22 12] + set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X8 + $T09}] 7]}] + set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X9 + $T10}] 12]}] + set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X10 + $T11}] 17]}] + set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X11 + $T12}] 22]}] + # [ABCD 12 7 13] [DABC 13 12 14] [CDAB 14 17 15] [BCDA 15 22 16] + set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X12 + $T13}] 7]}] + set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X13 + $T14}] 12]}] + set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X14 + $T15}] 17]}] + set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X15 + $T16}] 22]}] + + # Round 2. + # Let [abcd k s i] denote the operation + # a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s). + # Do the following 16 operations. + # [ABCD 1 5 17] [DABC 6 9 18] [CDAB 11 14 19] [BCDA 0 20 20] + set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X1 + $T17}] 5]}] + set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X6 + $T18}] 9]}] + set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X11 + $T19}] 14]}] + set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X0 + $T20}] 20]}] + # [ABCD 5 5 21] [DABC 10 9 22] [CDAB 15 14 23] [BCDA 4 20 24] + set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X5 + $T21}] 5]}] + set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X10 + $T22}] 9]}] + set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X15 + $T23}] 14]}] + set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X4 + $T24}] 20]}] + # [ABCD 9 5 25] [DABC 14 9 26] [CDAB 3 14 27] [BCDA 8 20 28] + set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X9 + $T25}] 5]}] + set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X14 + $T26}] 9]}] + set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X3 + $T27}] 14]}] + set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X8 + $T28}] 20]}] + # [ABCD 13 5 29] [DABC 2 9 30] [CDAB 7 14 31] [BCDA 12 20 32] + set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X13 + $T29}] 5]}] + set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X2 + $T30}] 9]}] + set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X7 + $T31}] 14]}] + set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X12 + $T32}] 20]}] + + # Round 3. + # Let [abcd k s t] [sic] denote the operation + # a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s). + # Do the following 16 operations. + # [ABCD 5 4 33] [DABC 8 11 34] [CDAB 11 16 35] [BCDA 14 23 36] + set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X5 + $T33}] 4]}] + set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X8 + $T34}] 11]}] + set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X11 + $T35}] 16]}] + set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X14 + $T36}] 23]}] + # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40] + set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X1 + $T37}] 4]}] + set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X4 + $T38}] 11]}] + set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X7 + $T39}] 16]}] + set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X10 + $T40}] 23]}] + # [ABCD 13 4 41] [DABC 0 11 42] [CDAB 3 16 43] [BCDA 6 23 44] + set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X13 + $T41}] 4]}] + set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X0 + $T42}] 11]}] + set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X3 + $T43}] 16]}] + set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X6 + $T44}] 23]}] + # [ABCD 9 4 45] [DABC 12 11 46] [CDAB 15 16 47] [BCDA 2 23 48] + set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X9 + $T45}] 4]}] + set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X12 + $T46}] 11]}] + set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X15 + $T47}] 16]}] + set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X2 + $T48}] 23]}] + + # Round 4. + # Let [abcd k s t] [sic] denote the operation + # a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s). + # Do the following 16 operations. + # [ABCD 0 6 49] [DABC 7 10 50] [CDAB 14 15 51] [BCDA 5 21 52] + set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X0 + $T49}] 6]}] + set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X7 + $T50}] 10]}] + set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X14 + $T51}] 15]}] + set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X5 + $T52}] 21]}] + # [ABCD 12 6 53] [DABC 3 10 54] [CDAB 10 15 55] [BCDA 1 21 56] + set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X12 + $T53}] 6]}] + set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X3 + $T54}] 10]}] + set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X10 + $T55}] 15]}] + set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X1 + $T56}] 21]}] + # [ABCD 8 6 57] [DABC 15 10 58] [CDAB 6 15 59] [BCDA 13 21 60] + set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X8 + $T57}] 6]}] + set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X15 + $T58}] 10]}] + set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X6 + $T59}] 15]}] + set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X13 + $T60}] 21]}] + # [ABCD 4 6 61] [DABC 11 10 62] [CDAB 2 15 63] [BCDA 9 21 64] + set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X4 + $T61}] 6]}] + set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X11 + $T62}] 10]}] + set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X2 + $T63}] 15]}] + set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X9 + $T64}] 21]}] + + # Then perform the following additions. (That is increment each + # of the four registers by the value it had before this block + # was started.) + incr A $AA + incr B $BB + incr C $CC + incr D $DD + } + # 3.5 Step 5. Output + + # ... begin with the low-order byte of A, and end with the high-order byte + # of D. + + return [bytes $A][bytes $B][bytes $C][bytes $D] + } + + # + # Here we inline/regsub the functions F, G, H, I and <<< + # + + namespace eval ::md5 { + #proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}} + regsub -all -- {\[ *F +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \2) | ((~\1) \& \3))} md5body + + #proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}} + regsub -all -- {\[ *G +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \3) | (\2 \& (~\3)))} md5body + + #proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}} + regsub -all -- {\[ *H +(\$.) +(\$.) +(\$.) *\]} $md5body {(\1 ^ \2 ^ \3)} md5body + + #proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}} + regsub -all -- {\[ *I +(\$.) +(\$.) +(\$.) *\]} $md5body {(\2 ^ (\1 | (~\3)))} md5body + + # bitwise left-rotate + if {0} { + proc md5pure::<<< {x i} { + # This works by bitwise-ORing together right piece and left + # piece so that the (original) right piece becomes the left + # piece and vice versa. + # + # The (original) right piece is a simple left shift. + # The (original) left piece should be a simple right shift + # but Tcl does sign extension on right shifts so we + # shift it 1 bit, mask off the sign, and finally shift + # it the rest of the way. + + # expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))} + + # + # New version, faster when inlining + # We replace inline (computing at compile time): + # R$i -> (32 - $i) + # S$i -> (0x7fffffff >> (31-$i)) + # + + expr { ($x << $i) | (($x >> [set R$i]) & [set S$i])} + } + } + # inline <<< + regsub -all -- {\[ *<<< +\[ *expr +({[^\}]*})\] +([0-9]+) *\]} $md5body {(([set x [expr \1]] << \2) | (($x >> R\2) \& S\2))} md5body + + # now replace the R and S + set map {} + foreach i { + 7 12 17 22 + 5 9 14 20 + 4 11 16 23 + 6 10 15 21 + } { + lappend map R$i [expr {32 - $i}] S$i [expr {0x7fffffff >> (31-$i)}] + } + + # inline the values of T + foreach \ + tName { + T01 T02 T03 T04 T05 T06 T07 T08 T09 T10 + T11 T12 T13 T14 T15 T16 T17 T18 T19 T20 + T21 T22 T23 T24 T25 T26 T27 T28 T29 T30 + T31 T32 T33 T34 T35 T36 T37 T38 T39 T40 + T41 T42 T43 T44 T45 T46 T47 T48 T49 T50 + T51 T52 T53 T54 T55 T56 T57 T58 T59 T60 + T61 T62 T63 T64 } \ + tVal { + 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee + 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501 + 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be + 0x6b901122 0xfd987193 0xa679438e 0x49b40821 + + 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa + 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8 + 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed + 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a + + 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c + 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70 + 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05 + 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665 + + 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039 + 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1 + 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1 + 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391 + } { + lappend map \$$tName $tVal + } + set md5body [string map $map $md5body] + + + # Finally, define the proc + proc md5 {msg} $md5body + + # unset auxiliary variables + unset md5body tName tVal map + } + + proc ::md5::byte0 {i} {expr {0xff & $i}} + proc ::md5::byte1 {i} {expr {(0xff00 & $i) >> 8}} + proc ::md5::byte2 {i} {expr {(0xff0000 & $i) >> 16}} + proc ::md5::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}} + + proc ::md5::bytes {i} { + format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i] + } + + # hmac: hash for message authentication + proc ::md5::hmac {key text} { + # if key is longer than 64 bytes, reset it to MD5(key). If shorter, + # pad it out with null (\x00) chars. + set keyLen [string length $key] + if {$keyLen > 64} { + set key [binary format H32 [md5 $key]] + set keyLen [string length $key] + } + + # ensure the key is padded out to 64 chars with nulls. + set padLen [expr {64 - $keyLen}] + append key [binary format "a$padLen" {}] + + # Split apart the key into a list of 16 little-endian words + binary scan $key i16 blocks + + # XOR key with ipad and opad values + set k_ipad {} + set k_opad {} + foreach i $blocks { + append k_ipad [binary format i [expr {$i ^ 0x36363636}]] + append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]] + } + + # Perform inner md5, appending its results to the outer key + append k_ipad $text + append k_opad [binary format H* [md5 $k_ipad]] + + # Perform outer md5 + md5 $k_opad + } +} + +package provide md5 1.4.4 diff --git a/tcllib/modules/md5/md5.test b/tcllib/modules/md5/md5.test new file mode 100644 index 0000000..a1791ec --- /dev/null +++ b/tcllib/modules/md5/md5.test @@ -0,0 +1,90 @@ +# -*- tcl -*- +# md5.test: tests for the md5 commands +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 2001 by ActiveState Tool Corp. +# All rights reserved. +# +# RCS: @(#) $Id: md5.test,v 1.11 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 md5.tcl md5 +} + +# ------------------------------------------------------------------------- + +if {[catch {package present Trf}] || [catch {::md5 -- test}]} { + puts "> pure Tcl" +} else { + puts "> Trf based" +} + +# ------------------------------------------------------------------------- + +test md5-1.0 {md5} { + catch {::md5::md5} result + set result +} [tcltest::wrongNumArgs "::md5::md5" "msg" 0] + +test md5-1.1 {md5} { + catch {::md5::hmac} result + set result +} [tcltest::wrongNumArgs "::md5::hmac" "key text" 0] + +test md5-1.2 {md5} { + catch {::md5::hmac key} result + set result +} [tcltest::wrongNumArgs "::md5::hmac" "key text" 1] + + +foreach {n msg expected} { + 1 "" + "d41d8cd98f00b204e9800998ecf8427e" + 2 "a" + "0cc175b9c0f1b6a831c399e269772661" + 3 "abc" + "900150983cd24fb0d6963f7d28e17f72" + 4 "message digest" + "f96b697d7cb7938d525a2f31aaf161d0" + 5 "abcdefghijklmnopqrstuvwxyz" + "c3fcd3d76192e4007dfb496cca67e13b" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "d174ab98d277d9f5a5611c2c9f419d9f" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "57edf4a22be3c955ac49da2e2107b67a" +} { + test md5-2.$n {md5} { + ::md5::md5 $msg + } $expected ; # {} +} + +foreach {n key text expected} { + 1 "" "" "74e6f7298a9c2d168935f58c001bad88" + 2 "foo" "hello" "ef2ac8901530db30aa56929adfe5e13b" + 3 "bar" "world" "dfc05594b019ed51535922a1295446e8" + 4 "key" "text" "d0ca6177c61c975fd2f8c07d8c6528c6" + 5 "md5" "hmac" "d189f362daf86a5c8e14ba4aba91b260" + 6 "hmac" "md5" "480343cf0f2d5931ec4923e81059fb84" + 7 "md5" "md5" "92c5fb986e345f21f181047ab939ec77" + 8 "hmac" "hmac" "08abbe58a55219789e3eede153808a56" + 9 "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world" + "cf0237466f9b3c773858a1892b474c9e" +} { + test md5-3.$n {hmac} { + ::md5::hmac $key $text + } $expected ; # {} +} + +testsuiteCleanup diff --git a/tcllib/modules/md5/md5c.tcl b/tcllib/modules/md5/md5c.tcl new file mode 100644 index 0000000..240f29a --- /dev/null +++ b/tcllib/modules/md5/md5c.tcl @@ -0,0 +1,148 @@ +# md5c.tcl - +# +# Wrapper for RSA's Message Digest in C +# +# Written by Jean-Claude Wippler <jcw@equi4.com> +# +# $Id: md5c.tcl,v 1.5 2009/05/06 22:46:10 patthoyts Exp $ + +package require critcl; # needs critcl +# @sak notprovided md5c +package provide md5c 0.12; # + +critcl::cheaders md5.h; # The RSA header file +critcl::csources md5.c; # The RSA MD5 implementation. + +namespace eval ::md5 { + + critcl::ccode { + #include <string.h> + #include "md5.h" + #include <assert.h> + + static + Tcl_ObjType md5_type; /* fast internal access representation */ + + static void + md5_free_rep(Tcl_Obj *obj) + { + MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; + Tcl_Free((char*)mp); + } + + static void + md5_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) + { + MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; + dup->internalRep.otherValuePtr = Tcl_Alloc(sizeof *mp); + memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); + dup->typePtr = &md5_type; + } + + static void + md5_string_rep(Tcl_Obj *obj) + { + unsigned char buf[16]; + Tcl_Obj *temp; + char *str; + MD5_CTX dup = *(MD5_CTX *) obj->internalRep.otherValuePtr; + + MD5Final(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 + md5_from_any(Tcl_Interp* ip, Tcl_Obj* obj) + { + assert(0); + return TCL_ERROR; + } + + static + Tcl_ObjType md5_type = { + "md5c", md5_free_rep, md5_dup_rep, md5_string_rep, md5_from_any + }; + } + + critcl::ccommand md5c {dummy ip objc objv} { + MD5_CTX *mp; + unsigned char *data; + int size; + Tcl_Obj *obj; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(ip, 1, objv, "data ?context?"); + return TCL_ERROR; + } + + if (objc == 3) { + if (objv[2]->typePtr != &md5_type && md5_from_any(ip, objv[2]) != TCL_OK) { + return TCL_ERROR; + } + obj = objv[2]; + if (Tcl_IsShared(obj)) { + obj = Tcl_DuplicateObj(obj); + } + } else { + mp = (MD5_CTX *)Tcl_Alloc(sizeof *mp); + MD5Init(mp); + obj = Tcl_NewObj(); + Tcl_InvalidateStringRep(obj); + obj->internalRep.otherValuePtr = mp; + obj->typePtr = &md5_type; + } + + mp = (MD5_CTX *) obj->internalRep.otherValuePtr; + data = Tcl_GetByteArrayFromObj(objv[1], &size); + MD5Update(mp, data, size); + Tcl_SetObjResult(ip, obj); + + return TCL_OK; + } +} + +if {[info exists pkgtest] && $pkgtest} { + + proc md5c_try {} { + foreach {msg expected} { + "" + "d41d8cd98f00b204e9800998ecf8427e" + "a" + "0cc175b9c0f1b6a831c399e269772661" + "abc" + "900150983cd24fb0d6963f7d28e17f72" + "message digest" + "f96b697d7cb7938d525a2f31aaf161d0" + "abcdefghijklmnopqrstuvwxyz" + "c3fcd3d76192e4007dfb496cca67e13b" + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "d174ab98d277d9f5a5611c2c9f419d9f" + "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "57edf4a22be3c955ac49da2e2107b67a" + } { + puts "testing: ::md5::md5c \"$msg\"" + binary scan [::md5::md5c $msg] H* computed + puts "computed: $computed" + if {0 != [string compare $computed $expected]} { + puts "expected: $expected" + puts "FAILED" + } + } + + foreach len {10 50 100 500 1000 5000 10000} { + set blanks [format %$len.0s ""] + puts "input length $len: [time {md5c $blanks} 1000]" + } + } + + md5c_try +} diff --git a/tcllib/modules/md5/md5v1.bench b/tcllib/modules/md5/md5v1.bench new file mode 100644 index 0000000..b0402f5 --- /dev/null +++ b/tcllib/modules/md5/md5v1.bench @@ -0,0 +1,47 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'md5' 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 ... +## Here we are testing version 1. + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget md5 +catch {namespace delete ::md5} +source [file join [file dirname [info script]] md5.tcl] + +set key "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "MD5 md5_ v1 $n" -pre { + set str [string repeat " " $n] + } -body { + md5::md5 $str + } + + bench -desc "MD5 hmac v1 $n" -pre { + set str [string repeat " " $n] + } -body { + md5::hmac $key $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/md5/md5v2.bench b/tcllib/modules/md5/md5v2.bench new file mode 100644 index 0000000..e9af056 --- /dev/null +++ b/tcllib/modules/md5/md5v2.bench @@ -0,0 +1,47 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'md5' 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 ... +## Here we are testing version 2. + +set moddir [file dirname [file dirname [info script]]] +lappend auto_path $moddir + +package forget md5 +catch {namespace delete ::md5} +source [file join [file dirname [info script]] md5x.tcl] + +set key "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "MD5 md5_ v2 $n" -pre { + set str [string repeat " " $n] + } -body { + md5::md5 $str + } + + bench -desc "MD5 hmac v2 $n" -pre { + set str [string repeat " " $n] + } -body { + md5::hmac -key $key -- $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/md5/md5x.tcl b/tcllib/modules/md5/md5x.tcl new file mode 100644 index 0000000..85cb7aa --- /dev/null +++ b/tcllib/modules/md5/md5x.tcl @@ -0,0 +1,713 @@ +# md5.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# MD5 defined by RFC 1321, "The MD5 Message-Digest Algorithm" +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" +# +# This is an implementation of MD5 based upon the example code given in +# RFC 1321 and upon the tcllib MD4 implementation and taking some ideas +# from the earlier tcllib md5 version by Don Libes. +# +# This implementation permits incremental updating of the hash and +# provides support for external compiled implementations either using +# critcl (md5c) or Trf. +# +# ------------------------------------------------------------------------- +# 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 + +namespace eval ::md5 { + variable accel + array set accel {critcl 0 cryptkit 0 trf 0} + + namespace export md5 hmac MD5Init MD5Update MD5Final + + variable uid + if {![info exists uid]} { + set uid 0 + } +} + +# ------------------------------------------------------------------------- + +# MD5Init -- +# +# Create and initialize an MD5 state variable. This will be +# cleaned up when we call MD5Final +# +proc ::md5::MD5Init {} { + variable accel + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token state + + # RFC1321:3.3 - Initialize MD5 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_MD5 + } elseif {$accel(trf)} { + set s {} + switch -exact -- $::tcl_platform(platform) { + windows { set s [open NUL w] } + unix { set s [open /dev/null w] } + } + if {$s != {}} { + fconfigure $s -translation binary -buffering none + ::md5 -attach $s -mode write \ + -read-type variable \ + -read-destination [subst $token](trfread) \ + -write-type variable \ + -write-destination [subst $token](trfwrite) + array set state [list trfread 0 trfwrite 0 trf $s] + } + } + return $token +} + +# MD5Update -- +# +# This is called to add more data into the hash. You may call this +# as many times as you require. Note that passing in "ABC" is equivalent +# to passing these letters in as separate calls -- hence this proc +# permits hashing of chunked data +# +# If we have a C-based implementation available, then we will use +# it here in preference to the pure-Tcl implementation. +# +proc ::md5::MD5Update {token data} { + variable accel + upvar #0 $token state + + if {$accel(critcl)} { + if {[info exists state(md5c)]} { + set state(md5c) [md5c $data $state(md5c)] + } else { + set state(md5c) [md5c $data] + } + return + } elseif {[info exists state(ckctx)]} { + if {[string length $data] > 0} { + cryptkit::cryptEncrypt $state(ckctx) $data + } + return + } elseif {[info exists state(trf)]} { + puts -nonewline $state(trf) $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} {} { + MD5Hash $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 +} + +# MD5Final -- +# +# This procedure is used to close the current hash and returns the +# hash data. Once this procedure has been called the hash context +# is freed and cannot be used again. +# +# Note that the output is 128 bits represented as binary data. +# +proc ::md5::MD5Final {token} { + upvar #0 $token state + + # Check for either of the C-compiled versions. + if {[info exists state(md5c)]} { + set r $state(md5c) + 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 + } + } elseif {[info exists state(trf)]} { + close $state(trf) + set r $state(trfwrite) + unset state + return $r + } + + # RFC1321: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] + + # RFC1321: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} {} { + MD5Hash $token [string range $state(i) $n [incr n 64]] + } + + # RFC1321: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)) +# + +# HMACInit -- +# +# This is equivalent to the MD5Init procedure except that a key is +# added into the algorithm +# +proc ::md5::HMACInit {K} { + + # Key K is adjusted to be 64 bytes long. If K is larger, then use + # the MD5 digest of K and pad this instead. + set len [string length $K] + if {$len > 64} { + set tok [MD5Init] + MD5Update $tok $K + set K [MD5Final $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 [MD5Init] + MD5Update $tok $Ki; # initialize with the inner pad + + # preserve the Ko value for the final stage. + # FRINK: nocheck + set [subst $tok](Ko) $Ko + + return $tok +} + +# HMACUpdate -- +# +# Identical to calling MD5Update +# +proc ::md5::HMACUpdate {token data} { + MD5Update $token $data + return +} + +# HMACFinal -- +# +# This is equivalent to the MD5Final procedure. The hash context is +# closed and the binary representation of the hash result is returned. +# +proc ::md5::HMACFinal {token} { + upvar #0 $token state + + set tok [MD5Init]; # init the outer hashing function + MD5Update $tok $state(Ko); # prepare with the outer pad. + MD5Update $tok [MD5Final $token]; # hash the inner result + return [MD5Final $tok] +} + +# ------------------------------------------------------------------------- +# Description: +# This is the core MD5 algorithm. It is a lot like the MD4 algorithm but +# includes an extra round and a set of constant modifiers throughout. +# +# Note: +# This function body is substituted later on to inline some of the +# procedures and to make is a bit more comprehensible. +# +set ::md5::MD5Hash_body { + variable $token + upvar 0 $token state + + # RFC1321: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 i] denote the operation + # a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s). + # Do the following 16 operations. + # [ABCD 0 7 1] [DABC 1 12 2] [CDAB 2 17 3] [BCDA 3 22 4] + set A [expr {$B + (($A + [F $B $C $D] + $X0 + $T01) <<< 7)}] + set D [expr {$A + (($D + [F $A $B $C] + $X1 + $T02) <<< 12)}] + set C [expr {$D + (($C + [F $D $A $B] + $X2 + $T03) <<< 17)}] + set B [expr {$C + (($B + [F $C $D $A] + $X3 + $T04) <<< 22)}] + # [ABCD 4 7 5] [DABC 5 12 6] [CDAB 6 17 7] [BCDA 7 22 8] + set A [expr {$B + (($A + [F $B $C $D] + $X4 + $T05) <<< 7)}] + set D [expr {$A + (($D + [F $A $B $C] + $X5 + $T06) <<< 12)}] + set C [expr {$D + (($C + [F $D $A $B] + $X6 + $T07) <<< 17)}] + set B [expr {$C + (($B + [F $C $D $A] + $X7 + $T08) <<< 22)}] + # [ABCD 8 7 9] [DABC 9 12 10] [CDAB 10 17 11] [BCDA 11 22 12] + set A [expr {$B + (($A + [F $B $C $D] + $X8 + $T09) <<< 7)}] + set D [expr {$A + (($D + [F $A $B $C] + $X9 + $T10) <<< 12)}] + set C [expr {$D + (($C + [F $D $A $B] + $X10 + $T11) <<< 17)}] + set B [expr {$C + (($B + [F $C $D $A] + $X11 + $T12) <<< 22)}] + # [ABCD 12 7 13] [DABC 13 12 14] [CDAB 14 17 15] [BCDA 15 22 16] + set A [expr {$B + (($A + [F $B $C $D] + $X12 + $T13) <<< 7)}] + set D [expr {$A + (($D + [F $A $B $C] + $X13 + $T14) <<< 12)}] + set C [expr {$D + (($C + [F $D $A $B] + $X14 + $T15) <<< 17)}] + set B [expr {$C + (($B + [F $C $D $A] + $X15 + $T16) <<< 22)}] + + # Round 2. + # Let [abcd k s i] denote the operation + # a = b + ((a + G(b,c,d) + X[k] + Ti) <<< s) + # Do the following 16 operations. + # [ABCD 1 5 17] [DABC 6 9 18] [CDAB 11 14 19] [BCDA 0 20 20] + set A [expr {$B + (($A + [G $B $C $D] + $X1 + $T17) <<< 5)}] + set D [expr {$A + (($D + [G $A $B $C] + $X6 + $T18) <<< 9)}] + set C [expr {$D + (($C + [G $D $A $B] + $X11 + $T19) <<< 14)}] + set B [expr {$C + (($B + [G $C $D $A] + $X0 + $T20) <<< 20)}] + # [ABCD 5 5 21] [DABC 10 9 22] [CDAB 15 14 23] [BCDA 4 20 24] + set A [expr {$B + (($A + [G $B $C $D] + $X5 + $T21) <<< 5)}] + set D [expr {$A + (($D + [G $A $B $C] + $X10 + $T22) <<< 9)}] + set C [expr {$D + (($C + [G $D $A $B] + $X15 + $T23) <<< 14)}] + set B [expr {$C + (($B + [G $C $D $A] + $X4 + $T24) <<< 20)}] + # [ABCD 9 5 25] [DABC 14 9 26] [CDAB 3 14 27] [BCDA 8 20 28] + set A [expr {$B + (($A + [G $B $C $D] + $X9 + $T25) <<< 5)}] + set D [expr {$A + (($D + [G $A $B $C] + $X14 + $T26) <<< 9)}] + set C [expr {$D + (($C + [G $D $A $B] + $X3 + $T27) <<< 14)}] + set B [expr {$C + (($B + [G $C $D $A] + $X8 + $T28) <<< 20)}] + # [ABCD 13 5 29] [DABC 2 9 30] [CDAB 7 14 31] [BCDA 12 20 32] + set A [expr {$B + (($A + [G $B $C $D] + $X13 + $T29) <<< 5)}] + set D [expr {$A + (($D + [G $A $B $C] + $X2 + $T30) <<< 9)}] + set C [expr {$D + (($C + [G $D $A $B] + $X7 + $T31) <<< 14)}] + set B [expr {$C + (($B + [G $C $D $A] + $X12 + $T32) <<< 20)}] + + # Round 3. + # Let [abcd k s i] denote the operation + # a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s) + # Do the following 16 operations. + # [ABCD 5 4 33] [DABC 8 11 34] [CDAB 11 16 35] [BCDA 14 23 36] + set A [expr {$B + (($A + [H $B $C $D] + $X5 + $T33) <<< 4)}] + set D [expr {$A + (($D + [H $A $B $C] + $X8 + $T34) <<< 11)}] + set C [expr {$D + (($C + [H $D $A $B] + $X11 + $T35) <<< 16)}] + set B [expr {$C + (($B + [H $C $D $A] + $X14 + $T36) <<< 23)}] + # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40] + set A [expr {$B + (($A + [H $B $C $D] + $X1 + $T37) <<< 4)}] + set D [expr {$A + (($D + [H $A $B $C] + $X4 + $T38) <<< 11)}] + set C [expr {$D + (($C + [H $D $A $B] + $X7 + $T39) <<< 16)}] + set B [expr {$C + (($B + [H $C $D $A] + $X10 + $T40) <<< 23)}] + # [ABCD 13 4 41] [DABC 0 11 42] [CDAB 3 16 43] [BCDA 6 23 44] + set A [expr {$B + (($A + [H $B $C $D] + $X13 + $T41) <<< 4)}] + set D [expr {$A + (($D + [H $A $B $C] + $X0 + $T42) <<< 11)}] + set C [expr {$D + (($C + [H $D $A $B] + $X3 + $T43) <<< 16)}] + set B [expr {$C + (($B + [H $C $D $A] + $X6 + $T44) <<< 23)}] + # [ABCD 9 4 45] [DABC 12 11 46] [CDAB 15 16 47] [BCDA 2 23 48] + set A [expr {$B + (($A + [H $B $C $D] + $X9 + $T45) <<< 4)}] + set D [expr {$A + (($D + [H $A $B $C] + $X12 + $T46) <<< 11)}] + set C [expr {$D + (($C + [H $D $A $B] + $X15 + $T47) <<< 16)}] + set B [expr {$C + (($B + [H $C $D $A] + $X2 + $T48) <<< 23)}] + + # Round 4. + # Let [abcd k s i] denote the operation + # a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s) + # Do the following 16 operations. + # [ABCD 0 6 49] [DABC 7 10 50] [CDAB 14 15 51] [BCDA 5 21 52] + set A [expr {$B + (($A + [I $B $C $D] + $X0 + $T49) <<< 6)}] + set D [expr {$A + (($D + [I $A $B $C] + $X7 + $T50) <<< 10)}] + set C [expr {$D + (($C + [I $D $A $B] + $X14 + $T51) <<< 15)}] + set B [expr {$C + (($B + [I $C $D $A] + $X5 + $T52) <<< 21)}] + # [ABCD 12 6 53] [DABC 3 10 54] [CDAB 10 15 55] [BCDA 1 21 56] + set A [expr {$B + (($A + [I $B $C $D] + $X12 + $T53) <<< 6)}] + set D [expr {$A + (($D + [I $A $B $C] + $X3 + $T54) <<< 10)}] + set C [expr {$D + (($C + [I $D $A $B] + $X10 + $T55) <<< 15)}] + set B [expr {$C + (($B + [I $C $D $A] + $X1 + $T56) <<< 21)}] + # [ABCD 8 6 57] [DABC 15 10 58] [CDAB 6 15 59] [BCDA 13 21 60] + set A [expr {$B + (($A + [I $B $C $D] + $X8 + $T57) <<< 6)}] + set D [expr {$A + (($D + [I $A $B $C] + $X15 + $T58) <<< 10)}] + set C [expr {$D + (($C + [I $D $A $B] + $X6 + $T59) <<< 15)}] + set B [expr {$C + (($B + [I $C $D $A] + $X13 + $T60) <<< 21)}] + # [ABCD 4 6 61] [DABC 11 10 62] [CDAB 2 15 63] [BCDA 9 21 64] + set A [expr {$B + (($A + [I $B $C $D] + $X4 + $T61) <<< 6)}] + set D [expr {$A + (($D + [I $A $B $C] + $X11 + $T62) <<< 10)}] + set C [expr {$D + (($C + [I $D $A $B] + $X2 + $T63) <<< 15)}] + set B [expr {$C + (($B + [I $C $D $A] + $X9 + $T64) <<< 21)}] + + # 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 ::md5::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} +proc ::md5::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 ::md5::<<< {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 {(\$[ABCD]) \+ \(\((.*)\)\s+<<<\s+(\d+)\)}\]} \ + $::md5::MD5Hash_body \ + {[expr {int(\1 + [<<< [expr {\2}] \3])}]} \ + ::md5::MD5Hash_body + +# RFC1321:3.4 - function F +proc ::md5::F {X Y Z} { + return [expr {($X & $Y) | ((~$X) & $Z)}] +} + +# Inline the F function +regsub -all -line \ + {\[F (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md5::MD5Hash_body \ + {( (\1 \& \2) | ((~\1) \& \3) )} \ + ::md5::MD5Hash_body + +# RFC1321:3.4 - function G +proc ::md5::G {X Y Z} { + return [expr {(($X & $Z) | ($Y & (~$Z)))}] +} + +# Inline the G function +regsub -all -line \ + {\[G (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md5::MD5Hash_body \ + {(((\1 \& \3) | (\2 \& (~\3))))} \ + ::md5::MD5Hash_body + +# RFC1321:3.4 - function H +proc ::md5::H {X Y Z} { + return [expr {$X ^ $Y ^ $Z}] +} + +# Inline the H function +regsub -all -line \ + {\[H (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md5::MD5Hash_body \ + {(\1 ^ \2 ^ \3)} \ + ::md5::MD5Hash_body + +# RFC1321:3.4 - function I +proc ::md5::I {X Y Z} { + return [expr {$Y ^ ($X | (~$Z))}] +} + +# Inline the I function +regsub -all -line \ + {\[I (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ + $::md5::MD5Hash_body \ + {(\2 ^ (\1 | (~\3)))} \ + ::md5::MD5Hash_body + + +# RFC 1321:3.4 step 4: inline the set of constant modifiers. +namespace eval md5 { + foreach tName { + T01 T02 T03 T04 T05 T06 T07 T08 T09 T10 + T11 T12 T13 T14 T15 T16 T17 T18 T19 T20 + T21 T22 T23 T24 T25 T26 T27 T28 T29 T30 + T31 T32 T33 T34 T35 T36 T37 T38 T39 T40 + T41 T42 T43 T44 T45 T46 T47 T48 T49 T50 + T51 T52 T53 T54 T55 T56 T57 T58 T59 T60 + T61 T62 T63 T64 + } tVal { + 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee + 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501 + 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be + 0x6b901122 0xfd987193 0xa679438e 0x49b40821 + + 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa + 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8 + 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed + 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a + + 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c + 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70 + 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05 + 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665 + + 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039 + 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1 + 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1 + 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391 + } { + lappend map \$$tName $tVal + } + set ::md5::MD5Hash_body [string map $map $::md5::MD5Hash_body] + unset map tName tVal +} + +# Define the MD5 hashing procedure with inline functions. +proc ::md5::MD5Hash {token msg} $::md5::MD5Hash_body +unset ::md5::MD5Hash_body + +# ------------------------------------------------------------------------- + +if {[package provide Trf] != {}} { + interp alias {} ::md5::Hex {} ::hex -mode encode -- +} else { + proc ::md5::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 ::md5::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require md5c}]} { + set r [expr {[info commands ::md5::md5c] != {}}] + } + } + cryptkit { + if {![catch {package require cryptkit}]} { + set r [expr {![catch {cryptkit::cryptInit}]}] + } + } + trf { + if {![catch {package require Trf}]} { + set r [expr {![catch {::md5 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 ::md5::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 ::md5::Chunk {token channel {chunksize 4096}} { + upvar #0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + MD5Update $token [read $channel $chunksize] +} + +# ------------------------------------------------------------------------- + +proc ::md5::md5 {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\nlen: [llength $args]" + } + } + 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 \"md5 ?-hex? -filename file | string\"" + } + set tok [MD5Init] + MD5Update $tok [lindex $args 0] + set r [MD5Final $tok] + + } else { + + set tok [MD5Init] + # 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 [MD5Final $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 ::md5::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 ::md5 { + variable e + foreach e {critcl cryptkit trf} { if {[LoadAccelerator $e]} { break } } + unset e +} + +package provide md5 2.0.7 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: + + diff --git a/tcllib/modules/md5/md5x.test b/tcllib/modules/md5/md5x.test new file mode 100644 index 0000000..b9aca39 --- /dev/null +++ b/tcllib/modules/md5/md5x.test @@ -0,0 +1,216 @@ +# -*- tcl -*- +# md5.test: tests for the md5 commands +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 2001 by ActiveState Tool Corp. +# All rights reserved. +# +# RCS: @(#) $Id: md5x.test,v 1.17 2008/04/08 00:33:07 patthoyts Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.2 +testsNeedTcltest 1.0 + +testing { + useLocal md5x.tcl md5 +} + +# ------------------------------------------------------------------------- + +if {[::md5::LoadAccelerator critcl]} { + puts "> critcl based" +} +if {[::md5::LoadAccelerator cryptkit]} { + puts "> cryptkit based" +} +if {[::md5::LoadAccelerator trf]} { + puts "> Trf based" +} +puts "> pure Tcl" + +# ------------------------------------------------------------------------- +# Handle multiple implementation testing +# + +array set preserve [array get ::md5::accel] + +proc implementations {} { + variable ::md5::accel + foreach {a v} [array get accel] {if {$v} {lappend r $a}} + lappend r tcl; set r +} + +proc select_implementation {impl} { + variable ::md5::accel + foreach e [array names accel] { set accel($e) 0 } + if {[string compare "tcl" $impl] != 0} { + set accel($impl) 1 + } +} + +proc reset_implementation {} { + variable ::md5::accel + array set accel [array get ::preserve] +} + +# ------------------------------------------------------------------------- + +test md5-v2-1.0 {md5} { + catch {::md5::md5} result + set result +} {wrong # args: should be "md5 ?-hex? -filename file | string"} +# [tcltest::wrongNumArgs "md5" "?-hex? -filename file | string" 0] + +test md5-v2-1.1 {md5} { + catch {::md5::hmac} result + set result +} {wrong # args: should be "hmac ?-hex? -key key -filename file | string"} +# [tcltest::wrongNumArgs "hmac" "?-hex? -key key -filename file | string" 0] + +test md5-v2-1.2 {md5} { + catch {::md5::hmac key} result + set result +} {wrong # args: should be "hmac ?-hex? -key key -filename file | string"} +# [tcltest::wrongNumArgs "hmac" "?-hex? -key key -filename file | string" 1] + + +set tests { + 1 "" + "D41D8CD98F00B204E9800998ECF8427E" + 2 "a" + "0CC175B9C0F1B6A831C399E269772661" + 3 "abc" + "900150983CD24FB0D6963F7D28E17F72" + 4 "message digest" + "F96B697D7CB7938D525A2F31AAF161D0" + 5 "abcdefghijklmnopqrstuvwxyz" + "C3FCD3D76192E4007DFB496CCA67E13B" + 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + "D174AB98D277D9F5A5611C2C9F419D9F" + 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" + "57EDF4A22BE3C955AC49DA2E2107B67A" + 8 "a\$apr1\$a" "020C3DD6931F7E94ECC99A1F4E4C53E2" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n msg expected} $tests { + test md5-v2-$impl-2.$n "md5 ($impl impl)" { + list [catch {::md5::md5 -hex -- $msg} msg] $msg + } [list 0 $expected] + } + reset_implementation +} + +set vectors { + 1 "" "" "74E6F7298A9C2D168935F58C001BAD88" + 2 "\x01" "" "DFA55EFBE6ED07FA2E056E57E949930A" + 3 "foo" "hello" "EF2AC8901530DB30AA56929ADFE5E13B" + 4 "bar" "world" "DFC05594B019ED51535922A1295446E8" + 5 "key" "text" "D0CA6177C61C975FD2F8C07D8C6528C6" + 6 "md5" "hmac" "D189F362DAF86A5C8E14BA4ABA91B260" + 7 "hmac" "md5" "480343CF0F2D5931EC4923E81059FB84" + 8 "md5" "md5" "92C5FB986E345F21F181047AB939EC77" + 9 "hmac" "hmac" "08ABBE58A55219789E3EEDE153808A56" + 10 "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world" + "CF0237466F9B3C773858A1892B474C9E" + 11 "-" "a" "E3BA60E98ED812A68AEB04A8FF57AC8E" + 12 "a" "-" "A9DD01C469578DCD4220600667DF6FFB" +} + +foreach impl [implementations] { + select_implementation $impl + foreach {n key text expected} $vectors { + test md5-v2-$impl-3.$n "hmac ($impl impl)" { + list [catch {::md5::hmac -hex -key $key -- $text} msg] $msg + } [list 0 $expected] + } + reset_implementation +} + +# ------------------------------------------------------------------------- +# RFC 2202 has a set of test vectors for HMAC-MD5 and HMAC-SHA1. +# This is those test vectors... +# ------------------------------------------------------------------------- + +set vectors \ + [list \ + 1 [string repeat \x0b 16] "Hi There" \ + 9294727A3638BB1C13F48EF8158BFC9D \ + 2 "Jefe" "what do ya want for nothing?" \ + 750C783E6AB0B503EAA86E310A5DB738 \ + 3 [string repeat \xaa 16] [string repeat \xdd 50] \ + 56BE34521D144C88DBB8C733F0E8B3F6 \ + 4 \ + [binary format H* 0102030405060708090a0b0c0d0e0f10111213141516171819]\ + [string repeat \xcd 50] \ + 697EAF0ACA3A3AEA3A75164746FFAA79 \ + 5 [string repeat \x0c 16] "Test With Truncation" \ + 56461EF2342EDC00F9BAB995690EFD4C \ + 6 [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key - Hash Key First" \ + 6B1AB7FE4BD7BF8F0B62E6CE61B9D0CD \ + 7 [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" \ + 6F630FAD67CDA0EE1FB1F562DB3AA53E \ + ] + +foreach impl [implementations] { + select_implementation $impl + foreach {n key msg hash} $vectors { + test md5-v2-$impl-4.$n "RFC2202 test vectors for HMAC-MD5 ($impl)" { + ::md5::hmac -hex -key $key -- $msg + } $hash + } +} + +# ------------------------------------------------------------------------- + +test md5-v2-6.1 {Check hashing data that begins with hyphen} { + list [catch {::md5::md5 -hex -hello} msg] $msg +} {0 110CD19610AD6247F30263C882670CC1} + +test md5-v2-6.2 {Check hashing data that begins with hyphen} { + list [catch {::md5::md5 -hex -- -hello} msg] $msg +} {0 110CD19610AD6247F30263C882670CC1} + +test md5-v2-6.3 {Check hashing data that begins with hyphen} { + list [catch {::md5::md5 -hex --} msg] $msg +} {0 CFAB1BA8C67C7C838DB98D666F02A132} + +test md5-v2-6.4 {Check hashing data that begins with hyphen} { + list [catch {::md5::md5 -hex -- --} msg] $msg +} {0 CFAB1BA8C67C7C838DB98D666F02A132} + +test md5-v2-7.1 {Check hmac data that begins with hyphen} { + list [catch {::md5::hmac -hex -key "" -hello} msg] $msg +} {0 6C39C49DA482D110B72B72F24E082E0F} + +test md5-v2-7.2 {Check hmac data that begins with hyphen} { + list [catch {::md5::hmac -hex -key "" -- -hello} msg] $msg +} {0 6C39C49DA482D110B72B72F24E082E0F} + +test md5-v2-7.3 {Check hmac data that begins with hyphen} { + list [catch {::md5::hmac -hex -key "" --} msg] $msg +} {0 8EB61D377088779210AD82659AECD631} + +test md5-v2-7.4 {Check hmac data that begins with hyphen} { + list [catch {::md5::hmac -hex -key "" -- --} msg] $msg +} {0 8EB61D377088779210AD82659AECD631} + +# ------------------------------------------------------------------------- + +testsuiteCleanup + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/md5/pkgIndex.tcl b/tcllib/modules/md5/pkgIndex.tcl new file mode 100644 index 0000000..64096ec --- /dev/null +++ b/tcllib/modules/md5/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded md5 2.0.7 [list source [file join $dir md5x.tcl]] +package ifneeded md5 1.4.4 [list source [file join $dir md5.tcl]] |