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/sha1 | |
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/sha1')
-rw-r--r-- | tcllib/modules/sha1/ChangeLog | 318 | ||||
-rw-r--r-- | tcllib/modules/sha1/pkgIndex.tcl | 14 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.bench | 46 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.c | 267 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.h | 26 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.man | 182 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.tcl | 813 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1.test | 201 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1c.tcl | 125 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1v1.tcl | 710 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha1v1.test | 227 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.bench | 52 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.c | 524 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.h | 83 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.man | 194 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.tcl | 832 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256.test | 97 | ||||
-rw-r--r-- | tcllib/modules/sha1/sha256c.tcl | 174 |
18 files changed, 4885 insertions, 0 deletions
diff --git a/tcllib/modules/sha1/ChangeLog b/tcllib/modules/sha1/ChangeLog new file mode 100644 index 0000000..b651988 --- /dev/null +++ b/tcllib/modules/sha1/ChangeLog @@ -0,0 +1,318 @@ +2013-12-06 Andreas Kupries <andreask@activestate.com> + + * sha1.man: Ticket [444358b66e]. Documented option --. + * sha256.man: + +2013-10-29 Andreas Kupries <andreask@activestate.com> + + * sha1.c: Replaced misuse of cheaders for -D... with proper + * sha1c.tcl: cflags. Depending on whether critcl v2 or v3 + * sha256.c: was used the TCL_BYTE_ORDER was not set, allowing + * sha256c.tcl: build of tcllibc with code for wrong byte order. + Also added code to detect missing definition, and fail build. + +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 ======================== + * + +2010-07-06 Andreas Kupries <andreask@activestate.com> + + * sha256.tcl (::sha2::HMACFinal): [Bug 2986744]: Added code + * sha256.man: limiting an intermediate value to int32 to make the + * pkgIndex.tcl: code workable for Tcl 8.5 and higher. Bumped + package version to 1.0.3. + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-10-27 Andreas Kupries <andreask@activestate.com> + + * sha256.h: Made the uint*_t typedef's conditional to prevent + their use on hpux-ia64. There they are in conflict with the + definitions in the system header _inttypes.h. + +2009-05-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1c.tcl: Fixed object leak in the critcl implementation. + * sha256c.tcl: + +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-03-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha256.man: Added documentation for the sha256 package. + * sha1.man: Fixed typos. + +2008-01-28 Andreas Kupries <andreask@activestate.com> + + * sha256c.tcl: Disabled the critcl::debug and critcl::cheaders -g + definitions. + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-05-03 Andreas Kupries <andreask@activestate.com> + + * sha1.tcl: Force-define loop variable for accel loader, so + * sha256.tcl: that sak will not fail in the unset when looking + for the package version via restricted eval. + +2007-03-25 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha256.c: gcc 4 has decided that assignment to a cast pointer is + to be denied. Therefore added work around. + +2007-03-23 Andreas Kupries <andreask@activestate.com> + + * sha256.tcl: Added MD hints. + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-11-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha256c.tcl: Support MSVC as well as gcc. + * sha256.h: (critcl2 can use gcc and/or msvc on windows) + * sha256.c: + +2006-10-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pkgIndex.tcl: Bumped versions of sha1, sha256 by a patchlevel + * sha1.man: due to the changes to the package internals. + * sha1.tcl: + * sha1c.tcl: + + * sha256.c: New files implementing sha256 in C + * sha256.h: Based on critcl. + * sha256c.tcl: + + * sha256.tcl: Rewritten to deal with multiple implementations, + * sha256.test: i.e. tcl and the new critcl one. + +2006-10-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.tcl: Management of multiple implementations rewritten to + * sha1.test: conform to the expections of the testsuite helper + commands. Testsuite rewritten to use the new helpers. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-03-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1v1.test: Copies of sha1.{tcl,test} for the v1 line. + * sha1v1.tcl: This duplication allows us to get rid of the package + index hackery for v1, enables the clean conversion of the code + in this directory into Tcl Modules, and allows proper separate + development of the two major versions in the future. + +2006-01-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha256.test: Fixed use of duplicate test names. + +2006-01-26 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.test: More boilerplate simplified via use of test support. + * sha256.test: + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.test: Hooked into the new common test support code. + * sha256.test: + +2005-10-24 Andreas Kupries <andreask@activestate.com> + + * sha1.bench: New file. Basic benchmarks for SHA hashes. + * sha256.bench: + +2005-10-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-10-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1.c: Fixed the byte order issue a better way and sorted + * sha1c.tcl: another problem on OpenBSD concerning headers. + * sha1.h: Added byte-order check to resolve bug #1315688. + +2005-09-30 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1.tcl: Refactored to permit implementation selection based + upon the current interpreter version to try and maximise the speed. + +2005-09-30 Andreas Kupries <andreask@activestate.com> + + * sha1.tcl: Applied [SF Tcllib Patch 1301707] to keep the size of + generated numbers within the bounds of 32 bits. + +2005-02-24 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha256.tcl: Speeded up the digest calculation. + * sha1.tcl: Arranged to run all available implementations in the + * sha1.test: tests. Speeded up the calculation. + +2005-02-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * pkgIndex.tcl: Provide version 1 and version 2 + * sha1.tcl: Rationalised the handling of accelerator extensions. + * sha1.test: Tests fixed for the above. + + * sha1.tcl: Support cryptkit as a possible accellerator. + * sha1.test: Enable testing of cryptkit implementation. + +2005-02-22 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha256.tcl: Inlined a load of expr calls to speed it up. + + * sha256.tcl: SHA-224 and SHA-256 pure-Tcl implementation + * sha256.test: Tests from FIPS 180-2 for SHA-224 and SHA-256 + This is the first version. It is correct (in that it passes the + FIPS test vectors) but slow. Speedups to follow. + +2005-02-21 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1.h: replaced the possibly buggy sample extension implementation + * sha1.c: with shiny new code from the NetBSD project. + + * sha1.test: Added some file tests (16K and 81K) + * sha1.tcl: Replaced steps 1 and 3 with slightly more efficient + but equivalent bit operations. Fixed an error with integer length + exposed with tcl8.5. Verified 8.2-8.5 + +2005-02-20 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1c.tcl: Imported the sha1 implementation from the Tcl sample + * sample.h: extension and created a critcl wrapper. + * sample.c: Added to the sak.tcl critcl generation code. + + * sha1.tcl: Re-implemented to support hashing data in chunks + * sha1.test: Included tests from RFC 2202 for HMAC-SHA1. + * sha1.man: This time we have kept the same API but with optional + extensions to use files/channels and to request the result as + binary. Now supports token based hashing as in md4, md5 and ripemd. + Incremented version to 2.0.0 + +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> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-10 Andreas Kupries <andreask@activestate.com> + + * pkgIndex.tcl: + * sha1.man: + * sha1.tcl: Fixed bug #614591. Set version of the package to to + 1.0.3 + +2003-03-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.tcl (sha1::sha1): Applied patch #637770 submitted by Donal + Fellows to fix problems on Mac OS X machines. This possibly + related to 64/32 bit arithmetic. See changes by Don Porter + below. + +2003-02-07 Pat Thoyts <patthoyts@users.sourceforge.net> + + * sha1.tcl: Check that we have a _working_ C implementation. + +2003-02-06 David N. Welton <davidw@dedasys.com> + + * sha1.tcl (sha1::time): Use 'lindex' instead of regexp to fetch + number from 'time' results. + +2002-02-20 Don Porter <dgp@users.sf.net> + + * sha1.tcl (sha1): Force 32-bit register arithmetic so that + the right answers are computed even on 64-bit platforms. [446997] + +2002-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * sha1.tcl (initK,sha1): Force 32-bit interpretation of constants + larger than INT_MAX on 32-bit processors, due to TIP#72. + +2002-02-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Version up to 1.0.2 to differentiate development from the + version in the tcllib 1.2 release. + + * sha1.tcl: Adding -- to hex/sha1 commands to prevent + misinterpretation of data if starting with -. + +2001-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.n: + * sha1.tcl: + * pkgIndex.tcl: Version up to 1.0.1 + +2001-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.test: Fixed broken error messages for 8.4. Using + [tcltest::getErrorMessage] now to get the correct message for + all versions of the core. Bug [440051] reported by Larry Virden. + +2001-06-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * sha1.tcl: Fixed dubious code reported by frink. + +2001-06-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * New module, 'sha1'. The code is Don Libes's <libes@nist.gov> + sha1pure, with Donal K. Fellows's patches to speed it up, and + extended with a soft dependency on Trf to allow higher speed if + the environment is right. diff --git a/tcllib/modules/sha1/pkgIndex.tcl b/tcllib/modules/sha1/pkgIndex.tcl new file mode 100644 index 0000000..1ed6860 --- /dev/null +++ b/tcllib/modules/sha1/pkgIndex.tcl @@ -0,0 +1,14 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded sha256 1.0.3 [list source [file join $dir sha256.tcl]] +package ifneeded sha1 2.0.3 [list source [file join $dir sha1.tcl]] +package ifneeded sha1 1.1.1 [list source [file join $dir sha1v1.tcl]] diff --git a/tcllib/modules/sha1/sha1.bench b/tcllib/modules/sha1/sha1.bench new file mode 100644 index 0000000..a7f7575 --- /dev/null +++ b/tcllib/modules/sha1/sha1.bench @@ -0,0 +1,46 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'sha1' 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 sha1 +catch {namespace delete ::sha1} +source [file join [file dirname [info script]] sha1.tcl] + +set key "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000 10000} { + bench -desc "SHA1 sha_ $n" -pre { + set str [string repeat " " $n] + } -body { + sha1::sha1 $str + } + + bench -desc "SHA1 hmac $n" -pre { + set str [string repeat " " $n] + } -body { + sha1::hmac $key $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/sha1/sha1.c b/tcllib/modules/sha1/sha1.c new file mode 100644 index 0000000..14b1a75 --- /dev/null +++ b/tcllib/modules/sha1/sha1.c @@ -0,0 +1,267 @@ +/* $NetBSD: sha1.c,v 1.3 2005/10/07 14:38:56 patthoyts Exp $ */ +/* $OpenBSD: sha1.c,v 1.9 1997/07/23 21:12:32 kstailey Exp $ */ + +/* + * SHA-1 in C + * By Steve Reid <steve@edmweb.com> + * 100% Public Domain + * + * Test Vectors (from FIPS PUB 180-1) + * "abc" + * A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D + * "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + * 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1 + * A million repetitions of "a" + * 34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#define SHA1HANDSOFF /* Copies data before messing with it. */ + +#include <assert.h> +#include <string.h> +#include "sha1.h" + +#ifndef TCL_BYTE_ORDER +#error "-DTCL_BYTE_ORDER missing" +#endif + +#ifndef _DIAGASSERT +#define _DIAGASSERT(cond) assert(cond) +#endif + +#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits)))) + +/* + * blk0() and blk() perform the initial expand. + * I got the idea of expanding during the round function from SSLeay + */ +#if TCL_BYTE_ORDER==1234 +# define blk0(i) (block->l[i] = (rol(block->l[i],24)&0xFF00FF00) \ + |(rol(block->l[i],8)&0x00FF00FF)) +#else +# define blk0(i) block->l[i] +#endif +#define blk(i) (block->l[i&15] = rol(block->l[(i+13)&15]^block->l[(i+8)&15] \ + ^block->l[(i+2)&15]^block->l[i&15],1)) + +/* + * (R0+R1), R2, R3, R4 are the different operations (rounds) used in SHA1 + */ +#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk0(i)+0x5A827999+rol(v,5);w=rol(w,30); +#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk(i)+0x5A827999+rol(v,5);w=rol(w,30); +#define R2(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0x6ED9EBA1+rol(v,5);w=rol(w,30); +#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+blk(i)+0x8F1BBCDC+rol(v,5);w=rol(w,30); +#define R4(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0xCA62C1D6+rol(v,5);w=rol(w,30); + + +typedef union { + my_char c[64]; + my_int32_t l[16]; +} CHAR64LONG16; + +#ifdef __sparc_v9__ +void do_R01(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *); +void do_R2(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *); +void do_R3(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *); +void do_R4(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *); + +#define nR0(v,w,x,y,z,i) R0(*v,*w,*x,*y,*z,i) +#define nR1(v,w,x,y,z,i) R1(*v,*w,*x,*y,*z,i) +#define nR2(v,w,x,y,z,i) R2(*v,*w,*x,*y,*z,i) +#define nR3(v,w,x,y,z,i) R3(*v,*w,*x,*y,*z,i) +#define nR4(v,w,x,y,z,i) R4(*v,*w,*x,*y,*z,i) + +void +do_R01(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *block) +{ + nR0(a,b,c,d,e, 0); nR0(e,a,b,c,d, 1); nR0(d,e,a,b,c, 2); nR0(c,d,e,a,b, 3); + nR0(b,c,d,e,a, 4); nR0(a,b,c,d,e, 5); nR0(e,a,b,c,d, 6); nR0(d,e,a,b,c, 7); + nR0(c,d,e,a,b, 8); nR0(b,c,d,e,a, 9); nR0(a,b,c,d,e,10); nR0(e,a,b,c,d,11); + nR0(d,e,a,b,c,12); nR0(c,d,e,a,b,13); nR0(b,c,d,e,a,14); nR0(a,b,c,d,e,15); + nR1(e,a,b,c,d,16); nR1(d,e,a,b,c,17); nR1(c,d,e,a,b,18); nR1(b,c,d,e,a,19); +} + +void +do_R2(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *block) +{ + nR2(a,b,c,d,e,20); nR2(e,a,b,c,d,21); nR2(d,e,a,b,c,22); nR2(c,d,e,a,b,23); + nR2(b,c,d,e,a,24); nR2(a,b,c,d,e,25); nR2(e,a,b,c,d,26); nR2(d,e,a,b,c,27); + nR2(c,d,e,a,b,28); nR2(b,c,d,e,a,29); nR2(a,b,c,d,e,30); nR2(e,a,b,c,d,31); + nR2(d,e,a,b,c,32); nR2(c,d,e,a,b,33); nR2(b,c,d,e,a,34); nR2(a,b,c,d,e,35); + nR2(e,a,b,c,d,36); nR2(d,e,a,b,c,37); nR2(c,d,e,a,b,38); nR2(b,c,d,e,a,39); +} + +void +do_R3(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *block) +{ + nR3(a,b,c,d,e,40); nR3(e,a,b,c,d,41); nR3(d,e,a,b,c,42); nR3(c,d,e,a,b,43); + nR3(b,c,d,e,a,44); nR3(a,b,c,d,e,45); nR3(e,a,b,c,d,46); nR3(d,e,a,b,c,47); + nR3(c,d,e,a,b,48); nR3(b,c,d,e,a,49); nR3(a,b,c,d,e,50); nR3(e,a,b,c,d,51); + nR3(d,e,a,b,c,52); nR3(c,d,e,a,b,53); nR3(b,c,d,e,a,54); nR3(a,b,c,d,e,55); + nR3(e,a,b,c,d,56); nR3(d,e,a,b,c,57); nR3(c,d,e,a,b,58); nR3(b,c,d,e,a,59); +} + +void +do_R4(my_int32_t *a, my_int32_t *b, my_int32_t *c, my_int32_t *d, my_int32_t *e, CHAR64LONG16 *block) +{ + nR4(a,b,c,d,e,60); nR4(e,a,b,c,d,61); nR4(d,e,a,b,c,62); nR4(c,d,e,a,b,63); + nR4(b,c,d,e,a,64); nR4(a,b,c,d,e,65); nR4(e,a,b,c,d,66); nR4(d,e,a,b,c,67); + nR4(c,d,e,a,b,68); nR4(b,c,d,e,a,69); nR4(a,b,c,d,e,70); nR4(e,a,b,c,d,71); + nR4(d,e,a,b,c,72); nR4(c,d,e,a,b,73); nR4(b,c,d,e,a,74); nR4(a,b,c,d,e,75); + nR4(e,a,b,c,d,76); nR4(d,e,a,b,c,77); nR4(c,d,e,a,b,78); nR4(b,c,d,e,a,79); +} +#endif + +/* + * Hash a single 512-bit block. This is the core of the algorithm. + */ +void SHA1Transform(state, buffer) + my_int32_t state[5]; + const my_char buffer[64]; +{ + my_int32_t a, b, c, d, e; + CHAR64LONG16 *block; + +#ifdef SHA1HANDSOFF + CHAR64LONG16 workspace; +#endif + + _DIAGASSERT(buffer != 0); + _DIAGASSERT(state != 0); + +#ifdef SHA1HANDSOFF + block = &workspace; + (void)memcpy(block, buffer, 64); +#else + block = (CHAR64LONG16 *)(void *)buffer; +#endif + + /* Copy context->state[] to working vars */ + a = state[0]; + b = state[1]; + c = state[2]; + d = state[3]; + e = state[4]; + +#ifdef __sparc_v9__ + do_R01(&a, &b, &c, &d, &e, block); + do_R2(&a, &b, &c, &d, &e, block); + do_R3(&a, &b, &c, &d, &e, block); + do_R4(&a, &b, &c, &d, &e, block); +#else + /* 4 rounds of 20 operations each. Loop unrolled. */ + R0(a,b,c,d,e, 0); R0(e,a,b,c,d, 1); R0(d,e,a,b,c, 2); R0(c,d,e,a,b, 3); + R0(b,c,d,e,a, 4); R0(a,b,c,d,e, 5); R0(e,a,b,c,d, 6); R0(d,e,a,b,c, 7); + R0(c,d,e,a,b, 8); R0(b,c,d,e,a, 9); R0(a,b,c,d,e,10); R0(e,a,b,c,d,11); + R0(d,e,a,b,c,12); R0(c,d,e,a,b,13); R0(b,c,d,e,a,14); R0(a,b,c,d,e,15); + R1(e,a,b,c,d,16); R1(d,e,a,b,c,17); R1(c,d,e,a,b,18); R1(b,c,d,e,a,19); + R2(a,b,c,d,e,20); R2(e,a,b,c,d,21); R2(d,e,a,b,c,22); R2(c,d,e,a,b,23); + R2(b,c,d,e,a,24); R2(a,b,c,d,e,25); R2(e,a,b,c,d,26); R2(d,e,a,b,c,27); + R2(c,d,e,a,b,28); R2(b,c,d,e,a,29); R2(a,b,c,d,e,30); R2(e,a,b,c,d,31); + R2(d,e,a,b,c,32); R2(c,d,e,a,b,33); R2(b,c,d,e,a,34); R2(a,b,c,d,e,35); + R2(e,a,b,c,d,36); R2(d,e,a,b,c,37); R2(c,d,e,a,b,38); R2(b,c,d,e,a,39); + R3(a,b,c,d,e,40); R3(e,a,b,c,d,41); R3(d,e,a,b,c,42); R3(c,d,e,a,b,43); + R3(b,c,d,e,a,44); R3(a,b,c,d,e,45); R3(e,a,b,c,d,46); R3(d,e,a,b,c,47); + R3(c,d,e,a,b,48); R3(b,c,d,e,a,49); R3(a,b,c,d,e,50); R3(e,a,b,c,d,51); + R3(d,e,a,b,c,52); R3(c,d,e,a,b,53); R3(b,c,d,e,a,54); R3(a,b,c,d,e,55); + R3(e,a,b,c,d,56); R3(d,e,a,b,c,57); R3(c,d,e,a,b,58); R3(b,c,d,e,a,59); + R4(a,b,c,d,e,60); R4(e,a,b,c,d,61); R4(d,e,a,b,c,62); R4(c,d,e,a,b,63); + R4(b,c,d,e,a,64); R4(a,b,c,d,e,65); R4(e,a,b,c,d,66); R4(d,e,a,b,c,67); + R4(c,d,e,a,b,68); R4(b,c,d,e,a,69); R4(a,b,c,d,e,70); R4(e,a,b,c,d,71); + R4(d,e,a,b,c,72); R4(c,d,e,a,b,73); R4(b,c,d,e,a,74); R4(a,b,c,d,e,75); + R4(e,a,b,c,d,76); R4(d,e,a,b,c,77); R4(c,d,e,a,b,78); R4(b,c,d,e,a,79); +#endif + + /* Add the working vars back into context.state[] */ + state[0] += a; + state[1] += b; + state[2] += c; + state[3] += d; + state[4] += e; + + /* Wipe variables */ + a = b = c = d = e = 0; +} + + +/* + * SHA1Init - Initialize new context + */ +void SHA1Init(context) + SHA1_CTX *context; +{ + + _DIAGASSERT(context != 0); + + /* SHA1 initialization constants */ + context->state[0] = 0x67452301; + context->state[1] = 0xEFCDAB89; + context->state[2] = 0x98BADCFE; + context->state[3] = 0x10325476; + context->state[4] = 0xC3D2E1F0; + context->count[0] = context->count[1] = 0; +} + + +/* + * Run your data through this. + */ +void SHA1Update(context, data, len) + SHA1_CTX *context; + const my_char *data; + my_int32_t len; +{ + my_int32_t i, j; + + _DIAGASSERT(context != 0); + _DIAGASSERT(data != 0); + + j = context->count[0]; + if ((context->count[0] += len << 3) < j) + context->count[1] += (len>>29)+1; + j = (j >> 3) & 63; + if ((j + len) > 63) { + (void)memcpy(&context->buffer[j], data, (i = 64-j)); + SHA1Transform(context->state, context->buffer); + for ( ; i + 63 < len; i += 64) + SHA1Transform(context->state, &data[i]); + j = 0; + } else { + i = 0; + } + (void)memcpy(&context->buffer[j], &data[i], len - i); +} + + +/* + * Add padding and return the message digest. + */ +void SHA1Final(digest, context) + my_char digest[20]; + SHA1_CTX* context; +{ + my_int32_t i; + my_char finalcount[8]; + + _DIAGASSERT(digest != 0); + _DIAGASSERT(context != 0); + + for (i = 0; i < 8; i++) { + finalcount[i] = (my_char)((context->count[(i >= 4 ? 0 : 1)] + >> ((3-(i & 3)) * 8) ) & 255); /* Endian independent */ + } + SHA1Update(context, (const my_char *)"\200", 1); + while ((context->count[0] & 504) != 448) + SHA1Update(context, (const my_char *)"\0", 1); + SHA1Update(context, finalcount, 8); /* Should cause a SHA1Transform() */ + + if (digest) { + for (i = 0; i < 20; i++) + digest[i] = (my_char) + ((context->state[i>>2] >> ((3-(i & 3)) * 8) ) & 255); + } +} diff --git a/tcllib/modules/sha1/sha1.h b/tcllib/modules/sha1/sha1.h new file mode 100644 index 0000000..6156243 --- /dev/null +++ b/tcllib/modules/sha1/sha1.h @@ -0,0 +1,26 @@ +/* $NetBSD: sha1.h,v 1.5 2006/10/02 23:42:08 patthoyts Exp $ */ + +/* + * SHA-1 in C + * By Steve Reid <steve@edmweb.com> + * 100% Public Domain + */ + +#ifndef _SYS_SHA1_H_ +#define _SYS_SHA1_H_ + +typedef unsigned int my_int32_t; +typedef unsigned char my_char; + +typedef struct { + my_int32_t state[5]; + my_int32_t count[2]; + my_char buffer[64]; +} SHA1_CTX; + +void SHA1Transform(my_int32_t state[5], const my_char buffer[64]); +void SHA1Init(SHA1_CTX *context); +void SHA1Update(SHA1_CTX *context, const my_char *data, my_int32_t len); +void SHA1Final(my_char digest[20], SHA1_CTX *context); + +#endif /* _SYS_SHA1_H_ */ diff --git a/tcllib/modules/sha1/sha1.man b/tcllib/modules/sha1/sha1.man new file mode 100644 index 0000000..0fb373b --- /dev/null +++ b/tcllib/modules/sha1/sha1.man @@ -0,0 +1,182 @@ +[manpage_begin sha1 n 2.0.3] +[see_also md4] +[see_also md5] +[see_also ripemd128] +[see_also ripemd160] +[keywords {FIPS 180-1}] +[keywords hashing] +[keywords message-digest] +[keywords {rfc 2104}] +[keywords security] +[keywords sha1] +[moddesc {SHA-x Message-Digest Algorithm}] +[copyright {2005, Pat Thoyts <patthoyts@users.sourceforge.net>}] +[titledesc {SHA1 Message-Digest Algorithm}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require sha1 [opt 2.0.3]] +[description] +[para] + +This package provides an implementation in Tcl of the SHA1 +message-digest algorithm as specified by FIPS PUB 180-1 (1). This +algorithm takes a message and generates a 160-bit digest from the +input. The SHA1 algorithm is related to the MD4 algorithm (2) but has +been strengthend against certain types of cryptographic attack. SHA1 +should be used in preference to MD4 or MD5 in new applications. + +[para] + +This package also includes support for creating keyed message-digests +using the HMAC algorithm from RFC 2104 (3) with SHA1 as the +message-digest. + +[section {COMMANDS}] + +[list_begin definitions] + +[call [cmd ::sha1::sha1] \ + [opt "[option -hex|-bin]"] \ + [lb] [option "-channel channel"] | \ + [option "-file filename"] | [opt [option --]] [arg "string"] [rb]] + +The command takes a message and returns the SHA1 digest of this message +as a hexadecimal string. You may request the result as binary data by +giving [arg "-bin"]. + +[para] + +The data to be hashed can be specified either as a string argument to +the [cmd "sha1"] 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. [emph NOTE] use of the channel or filename +options results in the internal use of [cmd vwait]. To avoid nested +event loops in Tk or tclhttpd applications you should use the +incremental programming API (see below). + +[para] + +Only one of [arg "-file"], [arg "-channel"] or [arg "string"] should be given. + +[para] If the [arg string] to hash can be mistaken for an option +(leading dash "-"), use the option [option --] before it to terminate +option processing and force interpretation as a string. + +[call [cmd "::sha1::hmac"] [arg "key"] [arg "string"]] +[call [cmd "::sha1::hmac"] \ + [opt "[option -hex|-bin]"] \ + [option "-key key"] \ + [lb] [option "-channel channel"] | \ + [option "-file filename"] | [opt [option --]] [arg "string"] [rb]] + +Calculate an Hashed Message Authentication digest (HMAC) using the SHA1 +digest algorithm. HMACs are described in RFC 2104 (3) and provide an SHA1 +digest that includes a key. All options other than [arg -key] are as +for the [cmd "::sha1::sha1"] command. + +[para] If the [arg string] to hash can be mistaken for an option +(leading dash "-"), use the option [option --] before it to terminate +option processing and force interpretation as a string. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +For the programmer, the SHA1 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 SHA1 hash operates on a token (equivalent to the +bucket). You call [cmd "SHA1Init"] to obtain a token and then call +[cmd "SHA1Update"] as many times as required to add data to the hash. To +release any resources and obtain the hash value, you then call +[cmd "SHA1Final"]. An equivalent set of functions gives you a keyed digest +(HMAC). + +[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. Failing that if you have the [package Trf] package then this can +be used otherwise there is a pure-tcl equivalent. The programming +interface remains the same in all cases. + +[list_begin definitions] + +[call [cmd "::sha1::SHA1Init"]] + +Begins a new SHA1 hash. Returns a token ID that must be used for the +remaining functions. + +[call [cmd "::sha1::SHA1Update"] [arg "token"] [arg "data"]] + +Add data to the hash identified by token. Calling +[emph {SHA1Update $token "abcd"}] is equivalent to calling +[emph {SHA1Update $token "ab"}] followed by +[emph {SHA1Update $token "cb"}]. See [sectref {EXAMPLES}]. + +[call [cmd "::sha1::SHA1Final"] [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 20 bytes representing the 160 bit SHA1 +digest value. + +[call [cmd "::sha1::HMACInit"] [arg "key"]] + +This is equivalent to the [cmd "::sha1::SHA1Init"] command except that +it requires the key that will be included in the HMAC. + +[call [cmd "::sha1::HMACUpdate"] [arg "token"] [arg "data"]] +[call [cmd "::sha1::HMACFinal"] [arg "token"]] + +These commands are identical to the SHA1 equivalent commands. + +[list_end] + +[section {EXAMPLES}] + +[example { +% sha1::sha1 "Tcl does SHA1" +285a6a91c45a9066bf39fcf24425796ef0b2a8bf +}] + +[example { +% sha1::hmac Sekret "Tcl does SHA1" +ae6251fa51b95b18cba2be95eb031d07475ff03c +}] + +[example { +% set tok [sha1::SHA1Init] +::sha1::1 +% sha1::SHA1Update $tok "Tcl " +% sha1::SHA1Update $tok "does " +% sha1::SHA1Update $tok "SHA1" +% sha1::Hex [sha1::SHA1Final $tok] +285a6a91c45a9066bf39fcf24425796ef0b2a8bf +}] + +[section {REFERENCES}] + +[list_begin enumerated] + +[enum] + "Secure Hash Standard", National Institute of Standards + and Technology, U.S. Department Of Commerce, April 1995. + ([uri http://www.itl.nist.gov/fipspubs/fip180-1.htm]) + +[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 sha1] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/sha1/sha1.tcl b/tcllib/modules/sha1/sha1.tcl new file mode 100644 index 0000000..df1a331 --- /dev/null +++ b/tcllib/modules/sha1/sha1.tcl @@ -0,0 +1,813 @@ +# sha1.tcl - +# +# Copyright (C) 2001 Don Libes <libes@nist.gov> +# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm" +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" +# +# This is an implementation of SHA1 based upon the example code given in +# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas +# and methods from the earlier tcllib sha1 version by Don Libes. +# +# This implementation permits incremental updating of the hash and +# provides support for external compiled implementations either using +# critcl (sha1c) or Trf. +# +# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# @mdgen EXCLUDE: sha1c.tcl + +package require Tcl 8.2; # tcl minimum version + +namespace eval ::sha1 { + variable accel + array set accel {tcl 0 critcl 0 cryptkit 0 trf 0} + + variable loaded {} + variable active + array set active {tcl 0 critcl 0 cryptkit 0 trf 0} + + namespace export sha1 hmac SHA1Init SHA1Update SHA1Final + + variable uid + if {![info exists uid]} { + set uid 0 + } +} + +# ------------------------------------------------------------------------- +# Management of sha1 implementations. + +# 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 ::sha1::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + tcl { + # Already present (this file) + set r 1 + } + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require sha1c}]} { + set r [expr {[info commands ::sha1::sha1c] != {}}] + } + } + cryptkit { + if {![catch {package require cryptkit}]} { + set r [expr {![catch {cryptkit::cryptInit}]}] + } + } + trf { + if {![catch {package require Trf}]} { + set r [expr {![catch {::sha1 aa} msg]}] + } + } + default { + return -code error "invalid accelerator $key:\ + must be one of [join [KnownImplementations] {, }]" + } + } + set accel($name) $r + return $r +} + +# ::sha1::Implementations -- +# +# Determines which implementations are +# present, i.e. loaded. +# +# Arguments: +# None. +# +# Results: +# A list of implementation keys. + +proc ::sha1::Implementations {} { + variable accel + set res {} + foreach n [array names accel] { + if {!$accel($n)} continue + lappend res $n + } + return $res +} + +# ::sha1::KnownImplementations -- +# +# Determines which implementations are known +# as possible implementations. +# +# Arguments: +# None. +# +# Results: +# A list of implementation keys. In the order +# of preference, most prefered first. + +proc ::sha1::KnownImplementations {} { + return {critcl cryptkit trf tcl} +} + +proc ::sha1::Names {} { + return { + critcl {tcllibc based} + cryptkit {cryptkit based} + trf {Trf based} + tcl {pure Tcl} + } +} + +# ::sha1::SwitchTo -- +# +# Activates a loaded named implementation. +# +# Arguments: +# key Name of the implementation to activate. +# +# Results: +# None. + +proc ::sha1::SwitchTo {key} { + variable accel + variable active + variable loaded + + if {[string equal $key $loaded]} { + # No change, nothing to do. + return + } elseif {![string equal $key ""]} { + # Validate the target implementation of the switch. + + if {![info exists accel($key)]} { + return -code error "Unable to activate unknown implementation \"$key\"" + } elseif {![info exists accel($key)] || !$accel($key)} { + return -code error "Unable to activate missing implementation \"$key\"" + } + } + + if {![string equal $loaded ""]} { + set active($loaded) 0 + } + if {![string equal $key ""]} { + set active($key) 1 + } + + # Remember the active implementation, for deactivation by future + # switches. + + set loaded $key + return +} + +# ------------------------------------------------------------------------- + +# SHA1Init -- +# +# Create and initialize an SHA1 state variable. This will be +# cleaned up when we call SHA1Final +# + +proc ::sha1::SHA1Init {} { + variable active + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token state + + # FIPS 180-1: 7 - Initialize the hash state + array set state \ + [list \ + A [expr {int(0x67452301)}] \ + B [expr {int(0xEFCDAB89)}] \ + C [expr {int(0x98BADCFE)}] \ + D [expr {int(0x10325476)}] \ + E [expr {int(0xC3D2E1F0)}] \ + n 0 i "" ] + if {$active(cryptkit)} { + cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_SHA + } elseif {$active(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 + ::sha1 -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 +} + +# SHA1Update -- +# +# 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 ::sha1::SHA1Update {token data} { + variable active + upvar #0 $token state + + if {$active(critcl)} { + if {[info exists state(sha1c)]} { + set state(sha1c) [sha1c $data $state(sha1c)] + } else { + set state(sha1c) [sha1c $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} {} { + SHA1Transform $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 +} + +# SHA1Final -- +# +# 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 160 bits represented as binary data. +# +proc ::sha1::SHA1Final {token} { + upvar #0 $token state + + # Check for either of the C-compiled versions. + if {[info exists state(sha1c)]} { + set r $state(sha1c) + unset state + return $r + } elseif {[info exists state(ckctx)]} { + cryptkit::cryptEncrypt $state(ckctx) "" + cryptkit::cryptGetAttributeString $state(ckctx) \ + CRYPT_CTXINFO_HASHVALUE r 20 + 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 + } + + # 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] + + # Append length in bits as big-endian wide int. + set dlen [expr {8 * $state(n)}] + append state(i) [binary format II 0 $dlen] + + # Calculate the hash for the remaining block. + set len [string length $state(i)] + for {set n 0} {($n + 64) <= $len} {} { + SHA1Transform $token [string range $state(i) $n [incr n 64]] + } + + # Output + set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)] + 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 SHA1Init procedure except that a key is +# added into the algorithm +# +proc ::sha1::HMACInit {K} { + + # Key K is adjusted to be 64 bytes long. If K is larger, then use + # the SHA1 digest of K and pad this instead. + set len [string length $K] + if {$len > 64} { + set tok [SHA1Init] + SHA1Update $tok $K + set K [SHA1Final $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 [SHA1Init] + SHA1Update $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 SHA1Update +# +proc ::sha1::HMACUpdate {token data} { + SHA1Update $token $data + return +} + +# HMACFinal -- +# +# This is equivalent to the SHA1Final procedure. The hash context is +# closed and the binary representation of the hash result is returned. +# +proc ::sha1::HMACFinal {token} { + upvar #0 $token state + + set tok [SHA1Init]; # init the outer hashing function + SHA1Update $tok $state(Ko); # prepare with the outer pad. + SHA1Update $tok [SHA1Final $token]; # hash the inner result + return [SHA1Final $tok] +} + +# ------------------------------------------------------------------------- +# Description: +# This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but +# includes an extra round and a set of constant modifiers throughout. +# +set ::sha1::SHA1Transform_body { + upvar #0 $token state + + # FIPS 180-1: 7a: Process Message in 16-Word Blocks + binary scan $msg I* blocks + set blockLen [llength $blocks] + for {set i 0} {$i < $blockLen} {incr i 16} { + set W [lrange $blocks $i [expr {$i+15}]] + + # FIPS 180-1: 7b: Expand the input into 80 words + # For t = 16 to 79 + # let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1 + set t3 12 + set t8 7 + set t14 1 + set t16 -1 + for {set t 16} {$t < 80} {incr t} { + set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \ + [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}] + lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}] + } + + # FIPS 180-1: 7c: Copy hash state. + set A $state(A) + set B $state(B) + set C $state(C) + set D $state(D) + set E $state(E) + + # FIPS 180-1: 7d: Do permutation rounds + # For t = 0 to 79 do + # TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt; + # E = D; D = C; C = S30(B); B = A; A = TEMP; + + # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19) + for {set t 0} {$t < 20} {incr t} { + set TEMP [F1 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39) + for {} {$t < 40} {incr t} { + set TEMP [F2 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59) + for {} {$t < 60} {incr t} { + set TEMP [F3 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79) + for {} {$t < 80} {incr t} { + set TEMP [F4 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # 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 + incr state(E) $E + } + + return +} + +proc ::sha1::F1 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ + + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff} +} + +proc ::sha1::F2 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ + + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff} +} + +proc ::sha1::F3 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ + + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff} +} + +proc ::sha1::F4 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ + + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff} +} + +proc ::sha1::rotl32 {v n} { + return [expr {((($v << $n) \ + | (($v >> (32 - $n)) \ + & (0x7FFFFFFF >> (31 - $n))))) \ + & 0xFFFFFFFF}] +} + + +# ------------------------------------------------------------------------- +# +# In order to get this code to go as fast as possible while leaving +# the main code readable we can substitute the above function bodies +# into the transform procedure. This inlines the code for us an avoids +# a procedure call overhead within the loops. +# +# We can do some minor tweaking to improve speed on Tcl < 8.5 where we +# know our arithmetic is limited to 64 bits. On > 8.5 we may have +# unconstrained integer arithmetic and must avoid letting it run away. +# + +regsub -all -line \ + {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body \ + {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {rotl32\(\$A,5\)} \ + $::sha1::SHA1Transform_body_tmp \ + {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[rotl32 \$B 30\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \ + ::sha1::SHA1Transform_body_tmp +# +# Version 2 avoids a few truncations to 32 bits in non-essential places. +# +regsub -all -line \ + {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body \ + {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {rotl32\(\$A,5\)} \ + $::sha1::SHA1Transform_body_tmp2 \ + {(($A << 5) | (($A >> 27) \& 0x1f))} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[rotl32 \$B 30\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \ + ::sha1::SHA1Transform_body_tmp2 + +if {[package vsatisfies [package provide Tcl] 8.5]} { + proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp +} else { + proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2 +} + +unset ::sha1::SHA1Transform_body +unset ::sha1::SHA1Transform_body_tmp +unset ::sha1::SHA1Transform_body_tmp2 + +# ------------------------------------------------------------------------- + +proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} +proc ::sha1::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 {((0xFF000000 & $v) >> 24) & 0xFF}] \ + [expr {(0xFF0000 & $v) >> 16}] \ + [expr {(0xFF00 & $v) >> 8}] \ + [expr {0xFF & $v}] +} + +# ------------------------------------------------------------------------- + +proc ::sha1::Hex {data} { + binary scan $data H* result + return $result +} + +# ------------------------------------------------------------------------- + +# Description: +# Pop the nth element off a list. Used in options processing. +# +proc ::sha1::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 ::sha1::Chunk {token channel {chunksize 4096}} { + upvar #0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + SHA1Update $token [read $channel $chunksize] +} + +# ------------------------------------------------------------------------- + +proc ::sha1::sha1 {args} { + array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} + if {[llength $args] == 1} { + set opts(-hex) 1 + } else { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 [concat -bin [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 \"sha1 ?-hex? -filename file | string\"" + } + set tok [SHA1Init] + SHA1Update $tok [lindex $args 0] + set r [SHA1Final $tok] + + } else { + + set tok [SHA1Init] + # FRINK: nocheck + set [subst $tok](reading) 1 + fileevent $opts(-channel) readable \ + [list [namespace origin Chunk] \ + $tok $opts(-channel) $opts(-chunksize)] + # FRINK: nocheck + vwait [subst $tok](reading) + set r [SHA1Final $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 ::sha1::hmac {args} { + array set opts {-hex 1 -filename {} -channel {} -chunksize 4096} + if {[llength $args] != 2} { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -key { set opts(-key) [Pop args 1] } + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 {[llength $args] == 2} { + set opts(-key) [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)] + # FRINK: nocheck + 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 ::sha1 { + variable e {} + foreach e [KnownImplementations] { + if {[LoadAccelerator $e]} { + SwitchTo $e + break + } + } + unset e +} + +package provide sha1 2.0.3 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/sha1/sha1.test b/tcllib/modules/sha1/sha1.test new file mode 100644 index 0000000..38f6dea --- /dev/null +++ b/tcllib/modules/sha1/sha1.test @@ -0,0 +1,201 @@ +# -*- tcl -*- +# sha1.test: tests for the sha1 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: sha1.test,v 1.13 2006/10/13 06:23:28 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 { + if {[useTcllibC]} { + useLocalKeep sha1.tcl sha1 + } else { + useLocal sha1.tcl sha1 + } + TestAccelInit sha1 +} + +# ------------------------------------------------------------------------- +# Now the package specific tests.... +# ------------------------------------------------------------------------- + +test sha1-1.0 {sha1} { + catch {::sha1::sha1} result + set result +} "wrong # args: should be \"sha1 ?-hex? -filename file | string\"" + +test sha1-1.1 {sha1} { + catch {::sha1::hmac} result + set result +} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\"" + +test sha1-1.2 {sha1} { + catch {::sha1::hmac key} result + set result +} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\"" + +# ------------------------------------------------------------------------- +# Digest / HMac + +set vectorsD { + "abc" + "a9993e364706816aba3e25717850c26c9cd0d89d" + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + "84983e441c3bd26ebaae4aa1f95129e5e54670f1" + "x" + "11f6ad8ec52a2984abaafd7c3b516503785c2072" +} + +set vectorsHM { + "" "" "fbdb1d1b18aa6c08324b7d64b71fb76370690e1d" + "foo" "hello" "4c883e9bc42763641bba04185d492de00de7ce2c" + "bar" "world" "a905e79f51faa446cb5a3888b577e34577ef7fce" + "key" "text" "369e2959eb49450338b212748f77d8ded74847bb" + "sha1" "hmac" "2660aeeccf432596e56f8f8260de971322e8935b" + "hmac" "sha1" "170523fd610da92dd4b4fb948a01a8365d66511a" + "sha1" "sha1" "5154473317173f66212fc59365233ffd9cbaab94" + "hmac" "hmac" "9e08393f6ac829c4385930ea38567dad582d958f" + "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world" + "dd80c541f75064d70e53a6b7b0a45210127f484e" +} + +# ------------------------------------------------------------------------- +# RFC 2202 has a set of test vectors for HMAC-MD5 and HMAC-SHA1. +# This is those test vectors... +# ------------------------------------------------------------------------- + +set vectorsRFC \ + [list \ + [string repeat \x0b 20] "Hi There" \ + b617318655057264e28bc0b6fb378c8ef146be00 \ + "Jefe" "what do ya want for nothing?" \ + effcdf6ae5eb2fa2d27416d5f184df9c259a7c79 \ + [string repeat \xaa 20] [string repeat \xdd 50] \ + 125d7342b9ac11cd91a39af48aa17b4f63f175d3 \ + \ + [binary format H* 0102030405060708090a0b0c0d0e0f10111213141516171819]\ + [string repeat \xcd 50] \ + 4c9007f4026250c6bc8414f9bf50c86c2d7235da \ + [string repeat \x0c 20] "Test With Truncation" \ + 4c1a03424b55e07fe7f27be1d58bb9324a9a5a04 \ + [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key - Hash Key First" \ + aa4ae5e15272d00e95705637ce8a3b55ed402112 \ + [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" \ + e8e99d0f45237d786d6bbaa7965c7808bbff1a91 \ + ] + +# ------------------------------------------------------------------------- + +test sha1-5.1 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hello} msg] $msg +} {0 bd32f1769a47f98c73348c87f5d6842ccd129911} + +test sha1-5.2 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hex -- -hello} msg] $msg +} {0 bd32f1769a47f98c73348c87f5d6842ccd129911} + +test sha1-5.3 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 --} msg] $msg +} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095} + +test sha1-5.4 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hex -- --} msg] $msg +} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095} + +test sha1-6.1 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac - -hello} msg] $msg +} {0 872c0aa5dca317c3be39a209c5aaa4d8139052b1} + +test sha1-6.2 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -- -hello} msg] $msg +} {0 a0e2547c63c9de64338efb19b0c6c533968748cc} + +test sha1-6.3 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -hex -key -- --} msg] $msg +} {0 d1efe5ea394610b39c10b97418278199ddd65766} + +test sha1-6.4 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -hex -key - --} msg] $msg +} {0 01c134b54ab872941acfce0cf3202f16ee64fb14} + +# ------------------------------------------------------------------------- + +set testfile [makeFile {} sha1[pid].data] + +# pattern repeatcount sha1-hash +set vectors \ + [list \ + 0 "\x00" 81922 a9fb4910179d5088ab606944ca0216e4403a5141 \ + 1 "\x5a" 81920 fef13bbee20792b7b2e65f15d5e4dd6ae04e2323 \ + 2 "\x01\x23\x45\x67\x89\xab\xcd\xef" 2048 \ + 846b9be26036a0b3c16a32805b5f3a85f8d0e0f5 \ + ] + +foreach {n pattern repeat hash} $vectors { + test sha1-7.$n "file hashing" { + list [catch { + set f [open $testfile w] + fconfigure $f -encoding binary -translation binary + puts -nonewline $f [string repeat $pattern $repeat] + close $f + sha1::sha1 -hex -file $testfile + } msg] $msg + } [list 0 $hash] +} + +removeFile $testfile + +# ------------------------------------------------------------------------- +# Implementation dependent tests last. + +TestAccelDo sha1 impl { + set n 0 + foreach {msg expected} $vectorsD { + test sha1-$impl-2.$n "sha1 ($impl impl)" { + list [catch {::sha1::sha1 $msg} r] $r + } [list 0 $expected] ; # {} + incr n + } + + set n 0 + foreach {key text expected} $vectorsHM { + test sha1-$impl-3.$n "hmac ($impl impl)" { + list [catch {::sha1::hmac $key $text} r] $r + } [list 0 $expected] ; # {} + incr n + } + + set n 0 + foreach {key msg hash} $vectorsRFC { + test sha1-$impl-4a.$n "RFC2202 test vectors for HMAC-SHA1 ($impl)" { + list [catch {::sha1::hmac $key $msg} r] $r + } [list 0 $hash] ; # {} + incr n + } +} + +# ------------------------------------------------------------------------- + +TestAccelExit sha1 +testsuiteCleanup + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/sha1/sha1c.tcl b/tcllib/modules/sha1/sha1c.tcl new file mode 100644 index 0000000..5f0f07e --- /dev/null +++ b/tcllib/modules/sha1/sha1c.tcl @@ -0,0 +1,125 @@ +# sha1c.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Wrapper for the Secure Hashing Algorithm (SHA1) +# +# $Id: sha1c.tcl,v 1.6 2009/05/07 00:35:10 patthoyts Exp $ + +package require critcl; # needs critcl +# @sak notprovided sha1c +package provide sha1c 2.0.3 + +critcl::cheaders sha1.h; # NetBSD SHA1 implementation +critcl::csources sha1.c; # NetBSD SHA1 implementation + +if {$tcl_platform(byteOrder) eq "littleEndian"} { + set byteOrder 1234 +} else { + set byteOrder 4321 +} +critcl::cflags -DTCL_BYTE_ORDER=$byteOrder + +namespace eval ::sha1 { + + critcl::ccode { + #include "sha1.h" + #include <stdlib.h> + #include <string.h> + #include <assert.h> + + static + Tcl_ObjType sha1_type; /* fast internal access representation */ + + static void + sha1_free_rep(Tcl_Obj* obj) + { + SHA1_CTX* mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; + Tcl_Free ((char*)mp); + } + + static void + sha1_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) + { + SHA1_CTX* mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; + dup->internalRep.otherValuePtr = Tcl_Alloc(sizeof *mp); + memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); + dup->typePtr = &sha1_type; + } + + static void + sha1_string_rep(Tcl_Obj* obj) + { + unsigned char buf[20]; + Tcl_Obj* temp; + char* str; + SHA1_CTX dup = *(SHA1_CTX*) obj->internalRep.otherValuePtr; + + SHA1Final(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 + sha1_from_any(Tcl_Interp* ip, Tcl_Obj* obj) + { + assert(0); + return TCL_ERROR; + } + + static + Tcl_ObjType sha1_type = { + "sha1c", sha1_free_rep, sha1_dup_rep, sha1_string_rep, + sha1_from_any + }; + } + + critcl::ccommand sha1c {dummy ip objc objv} { + SHA1_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 != &sha1_type + && sha1_from_any(ip, objv[2]) != TCL_OK) { + return TCL_ERROR; + } + obj = objv[2]; + if (Tcl_IsShared(obj)) { + obj = Tcl_DuplicateObj(obj); + } + } else { + obj = Tcl_NewObj(); + mp = (SHA1_CTX*) Tcl_Alloc(sizeof *mp); + SHA1Init(mp); + + if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { + obj->typePtr->freeIntRepProc(obj); + } + + obj->internalRep.otherValuePtr = mp; + obj->typePtr = &sha1_type; + } + + Tcl_InvalidateStringRep(obj); + + mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; + data = Tcl_GetByteArrayFromObj(objv[1], &size); + SHA1Update(mp, data, size); + + Tcl_SetObjResult(ip, obj); + return TCL_OK; + } +} diff --git a/tcllib/modules/sha1/sha1v1.tcl b/tcllib/modules/sha1/sha1v1.tcl new file mode 100644 index 0000000..ea2c94f --- /dev/null +++ b/tcllib/modules/sha1/sha1v1.tcl @@ -0,0 +1,710 @@ +# sha1.tcl - +# +# Copyright (C) 2001 Don Libes <libes@nist.gov> +# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm" +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" +# +# This is an implementation of SHA1 based upon the example code given in +# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas +# and methods from the earlier tcllib sha1 version by Don Libes. +# +# This implementation permits incremental updating of the hash and +# provides support for external compiled implementations either using +# critcl (sha1c) or Trf. +# +# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# @mdgen EXCLUDE: sha1c.tcl + +package require Tcl 8.2; # tcl minimum version + +namespace eval ::sha1 { + variable accel + array set accel {critcl 0 cryptkit 0 trf 0} + + namespace export sha1 hmac SHA1Init SHA1Update SHA1Final + + variable uid + if {![info exists uid]} { + set uid 0 + } +} + +# ------------------------------------------------------------------------- + +# SHA1Init -- +# +# Create and initialize an SHA1 state variable. This will be +# cleaned up when we call SHA1Final +# +proc ::sha1::SHA1Init {} { + variable accel + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token state + + # FIPS 180-1: 7 - Initialize the hash state + array set state \ + [list \ + A [expr {int(0x67452301)}] \ + B [expr {int(0xEFCDAB89)}] \ + C [expr {int(0x98BADCFE)}] \ + D [expr {int(0x10325476)}] \ + E [expr {int(0xC3D2E1F0)}] \ + n 0 i "" ] + if {$accel(cryptkit)} { + cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_SHA + } 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 + ::sha1 -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 +} + +# SHA1Update -- +# +# 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 ::sha1::SHA1Update {token data} { + variable accel + upvar #0 $token state + + if {$accel(critcl)} { + if {[info exists state(sha1c)]} { + set state(sha1c) [sha1c $data $state(sha1c)] + } else { + set state(sha1c) [sha1c $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} {} { + SHA1Transform $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 +} + +# SHA1Final -- +# +# 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 160 bits represented as binary data. +# +proc ::sha1::SHA1Final {token} { + upvar #0 $token state + + # Check for either of the C-compiled versions. + if {[info exists state(sha1c)]} { + set r $state(sha1c) + unset state + return $r + } elseif {[info exists state(ckctx)]} { + cryptkit::cryptEncrypt $state(ckctx) "" + cryptkit::cryptGetAttributeString $state(ckctx) \ + CRYPT_CTXINFO_HASHVALUE r 20 + 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 + } + + # 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] + + # Append length in bits as big-endian wide int. + set dlen [expr {8 * $state(n)}] + append state(i) [binary format II 0 $dlen] + + # Calculate the hash for the remaining block. + set len [string length $state(i)] + for {set n 0} {($n + 64) <= $len} {} { + SHA1Transform $token [string range $state(i) $n [incr n 64]] + } + + # Output + set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)] + 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 SHA1Init procedure except that a key is +# added into the algorithm +# +proc ::sha1::HMACInit {K} { + + # Key K is adjusted to be 64 bytes long. If K is larger, then use + # the SHA1 digest of K and pad this instead. + set len [string length $K] + if {$len > 64} { + set tok [SHA1Init] + SHA1Update $tok $K + set K [SHA1Final $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 [SHA1Init] + SHA1Update $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 SHA1Update +# +proc ::sha1::HMACUpdate {token data} { + SHA1Update $token $data + return +} + +# HMACFinal -- +# +# This is equivalent to the SHA1Final procedure. The hash context is +# closed and the binary representation of the hash result is returned. +# +proc ::sha1::HMACFinal {token} { + upvar #0 $token state + + set tok [SHA1Init]; # init the outer hashing function + SHA1Update $tok $state(Ko); # prepare with the outer pad. + SHA1Update $tok [SHA1Final $token]; # hash the inner result + return [SHA1Final $tok] +} + +# ------------------------------------------------------------------------- +# Description: +# This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but +# includes an extra round and a set of constant modifiers throughout. +# +set ::sha1::SHA1Transform_body { + upvar #0 $token state + + # FIPS 180-1: 7a: Process Message in 16-Word Blocks + binary scan $msg I* blocks + set blockLen [llength $blocks] + for {set i 0} {$i < $blockLen} {incr i 16} { + set W [lrange $blocks $i [expr {$i+15}]] + + # FIPS 180-1: 7b: Expand the input into 80 words + # For t = 16 to 79 + # let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1 + set t3 12 + set t8 7 + set t14 1 + set t16 -1 + for {set t 16} {$t < 80} {incr t} { + set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \ + [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}] + lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}] + } + + # FIPS 180-1: 7c: Copy hash state. + set A $state(A) + set B $state(B) + set C $state(C) + set D $state(D) + set E $state(E) + + # FIPS 180-1: 7d: Do permutation rounds + # For t = 0 to 79 do + # TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt; + # E = D; D = C; C = S30(B); B = A; A = TEMP; + + # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19) + for {set t 0} {$t < 20} {incr t} { + set TEMP [F1 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39) + for {} {$t < 40} {incr t} { + set TEMP [F2 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59) + for {} {$t < 60} {incr t} { + set TEMP [F3 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79) + for {} {$t < 80} {incr t} { + set TEMP [F4 $A $B $C $D $E [lindex $W $t]] + set E $D + set D $C + set C [rotl32 $B 30] + set B $A + set A $TEMP + } + + # 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 + incr state(E) $E + } + + return +} + +proc ::sha1::F1 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ + + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff} +} + +proc ::sha1::F2 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \ + + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff} +} + +proc ::sha1::F3 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ + + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff} +} + +proc ::sha1::F4 {A B C D E W} { + expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \ + + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff} +} + +proc ::sha1::rotl32 {v n} { + return [expr {((($v << $n) \ + | (($v >> (32 - $n)) \ + & (0x7FFFFFFF >> (31 - $n))))) \ + & 0xFFFFFFFF}] +} + + +# ------------------------------------------------------------------------- +# +# In order to get this code to go as fast as possible while leaving +# the main code readable we can substitute the above function bodies +# into the transform procedure. This inlines the code for us an avoids +# a procedure call overhead within the loops. +# +# We can do some minor tweaking to improve speed on Tcl < 8.5 where we +# know our arithmetic is limited to 64 bits. On > 8.5 we may have +# unconstrained integer arithmetic and must avoid letting it run away. +# + +regsub -all -line \ + {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body \ + {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {rotl32\(\$A,5\)} \ + $::sha1::SHA1Transform_body_tmp \ + {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \ + ::sha1::SHA1Transform_body_tmp + +regsub -all -line \ + {\[rotl32 \$B 30\]} \ + $::sha1::SHA1Transform_body_tmp \ + {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \ + ::sha1::SHA1Transform_body_tmp +# +# Version 2 avoids a few truncations to 32 bits in non-essential places. +# +regsub -all -line \ + {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body \ + {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {rotl32\(\$A,5\)} \ + $::sha1::SHA1Transform_body_tmp2 \ + {(($A << 5) | (($A >> 27) \& 0x1f))} \ + ::sha1::SHA1Transform_body_tmp2 + +regsub -all -line \ + {\[rotl32 \$B 30\]} \ + $::sha1::SHA1Transform_body_tmp2 \ + {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \ + ::sha1::SHA1Transform_body_tmp2 + +if {[package vsatisfies [package provide Tcl] 8.5]} { + proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp +} else { + proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2 +} + +unset ::sha1::SHA1Transform_body_tmp +unset ::sha1::SHA1Transform_body_tmp2 + +# ------------------------------------------------------------------------- + +proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} +proc ::sha1::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 {((0xFF000000 & $v) >> 24) & 0xFF}] \ + [expr {(0xFF0000 & $v) >> 16}] \ + [expr {(0xFF00 & $v) >> 8}] \ + [expr {0xFF & $v}] +} + +# ------------------------------------------------------------------------- + +proc ::sha1::Hex {data} { + binary scan $data H* result + return $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 ::sha1::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require sha1c}]} { + set r [expr {[info commands ::sha1::sha1c] != {}}] + } + } + cryptkit { + if {![catch {package require cryptkit}]} { + set r [expr {![catch {cryptkit::cryptInit}]}] + } + } + trf { + if {![catch {package require Trf}]} { + set r [expr {![catch {::sha1 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 ::sha1::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 ::sha1::Chunk {token channel {chunksize 4096}} { + upvar #0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + SHA1Update $token [read $channel $chunksize] +} + +# ------------------------------------------------------------------------- + +proc ::sha1::sha1 {args} { + array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} + if {[llength $args] == 1} { + set opts(-hex) 1 + } else { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 [concat -bin [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 \"sha1 ?-hex? -filename file | string\"" + } + set tok [SHA1Init] + SHA1Update $tok [lindex $args 0] + set r [SHA1Final $tok] + + } else { + + set tok [SHA1Init] + # FRINK: nocheck + set [subst $tok](reading) 1 + fileevent $opts(-channel) readable \ + [list [namespace origin Chunk] \ + $tok $opts(-channel) $opts(-chunksize)] + # FRINK: nocheck + vwait [subst $tok](reading) + set r [SHA1Final $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 ::sha1::hmac {args} { + array set opts {-hex 1 -filename {} -channel {} -chunksize 4096} + if {[llength $args] != 2} { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -key { set opts(-key) [Pop args 1] } + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 {[llength $args] == 2} { + set opts(-key) [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)] + # FRINK: nocheck + 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 ::sha1 { + variable e {} + foreach e {critcl cryptkit trf} { if {[LoadAccelerator $e]} { break } } + unset e +} + +package provide sha1 1.1.1 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: + + diff --git a/tcllib/modules/sha1/sha1v1.test b/tcllib/modules/sha1/sha1v1.test new file mode 100644 index 0000000..bb0ded1 --- /dev/null +++ b/tcllib/modules/sha1/sha1v1.test @@ -0,0 +1,227 @@ +# -*- tcl -*- +# sha1.test: tests for the sha1 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: sha1v1.test,v 1.2 2006/10/09 21:41:42 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 sha1v1.tcl sha1 +} + +# ------------------------------------------------------------------------- +# Now the package specific tests.... +# ------------------------------------------------------------------------- + +if {[::sha1::LoadAccelerator critcl]} { + puts "> critcl based" +} +if {[::sha1::LoadAccelerator cryptkit]} { + puts "> cryptkit based" +} +if {[::sha1::LoadAccelerator trf]} { + puts "> Trf based" +} +puts "> pure Tcl" + +# ------------------------------------------------------------------------- +# Handle multiple implementation testing +# + +array set preserve [array get ::sha1::accel] + +proc implementations {} { + variable ::sha1::accel + foreach {a v} [array get accel] {if {$v} {lappend r $a}} + lappend r tcl; set r +} + +proc select_implementation {impl} { + variable ::sha1::accel + foreach e [array names accel] { set accel($e) 0 } + if {[string compare "tcl" $impl] != 0} { + set accel($impl) 1 + } +} + +proc reset_implementation {} { + variable ::sha1::accel + array set accel [array get ::preserve] +} + +# ------------------------------------------------------------------------- + +test sha1-1.0 {sha1} { + catch {::sha1::sha1} result + set result +} "wrong # args: should be \"sha1 ?-hex? -filename file | string\"" + +test sha1-1.1 {sha1} { + catch {::sha1::hmac} result + set result +} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\"" + +test sha1-1.2 {sha1} { + catch {::sha1::hmac key} result + set result +} "wrong # args: should be \"hmac ?-hex? -key key -filename file | string\"" + +set vectors { + 1 "abc" + "a9993e364706816aba3e25717850c26c9cd0d89d" + 2 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + "84983e441c3bd26ebaae4aa1f95129e5e54670f1" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n msg expected} $vectors { + test sha1-$impl-2.$n "sha1 ($impl impl)" { + list [catch {::sha1::sha1 $msg} r] $r + } [list 0 $expected] + } + reset_implementation +} + +set vectors { + 1 "" "" "fbdb1d1b18aa6c08324b7d64b71fb76370690e1d" + 2 "foo" "hello" "4c883e9bc42763641bba04185d492de00de7ce2c" + 3 "bar" "world" "a905e79f51faa446cb5a3888b577e34577ef7fce" + 4 "key" "text" "369e2959eb49450338b212748f77d8ded74847bb" + 5 "sha1" "hmac" "2660aeeccf432596e56f8f8260de971322e8935b" + 6 "hmac" "sha1" "170523fd610da92dd4b4fb948a01a8365d66511a" + 7 "sha1" "sha1" "5154473317173f66212fc59365233ffd9cbaab94" + 8 "hmac" "hmac" "9e08393f6ac829c4385930ea38567dad582d958f" + 9 "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" "hello world" + "dd80c541f75064d70e53a6b7b0a45210127f484e" +} +foreach impl [implementations] { + select_implementation $impl + foreach {n key text expected} $vectors { + test sha1-$impl-3.$n "hmac ($impl impl)" { + list [catch {::sha1::hmac $key $text} r] $r + } [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 20] "Hi There" \ + b617318655057264e28bc0b6fb378c8ef146be00 \ + 2 "Jefe" "what do ya want for nothing?" \ + effcdf6ae5eb2fa2d27416d5f184df9c259a7c79 \ + 3 [string repeat \xaa 20] [string repeat \xdd 50] \ + 125d7342b9ac11cd91a39af48aa17b4f63f175d3 \ + 4 \ + [binary format H* 0102030405060708090a0b0c0d0e0f10111213141516171819]\ + [string repeat \xcd 50] \ + 4c9007f4026250c6bc8414f9bf50c86c2d7235da \ + 5 [string repeat \x0c 20] "Test With Truncation" \ + 4c1a03424b55e07fe7f27be1d58bb9324a9a5a04 \ + 6 [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key - Hash Key First" \ + aa4ae5e15272d00e95705637ce8a3b55ed402112 \ + 7 [string repeat \xaa 80] \ + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" \ + e8e99d0f45237d786d6bbaa7965c7808bbff1a91 \ + ] + +foreach impl [implementations] { + select_implementation $impl + foreach {n key msg hash} $vectors { + test sha1-$impl-4a.$n "RFC2202 test vectors for HMAC-SHA1 ($impl)" { + list [catch {::sha1::hmac $key $msg} r] $r + } [list 0 $hash] + } + reset_implementation +} + +# ------------------------------------------------------------------------- + +test sha1-5.1 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hello} msg] $msg +} {0 bd32f1769a47f98c73348c87f5d6842ccd129911} + +test sha1-5.2 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hex -- -hello} msg] $msg +} {0 bd32f1769a47f98c73348c87f5d6842ccd129911} + +test sha1-5.3 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 --} msg] $msg +} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095} + +test sha1-5.4 {Check hashing data that begins with hyphen} { + list [catch {::sha1::sha1 -hex -- --} msg] $msg +} {0 e6a9fc04320a924f46c7c737432bb0389d9dd095} + +test sha1-6.1 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac - -hello} msg] $msg +} {0 872c0aa5dca317c3be39a209c5aaa4d8139052b1} + +test sha1-6.2 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -- -hello} msg] $msg +} {0 a0e2547c63c9de64338efb19b0c6c533968748cc} + +test sha1-6.3 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -hex -key -- --} msg] $msg +} {0 d1efe5ea394610b39c10b97418278199ddd65766} + +test sha1-6.4 {Check hashing data that begins with hyphen} { + list [catch {::sha1::hmac -hex -key - --} msg] $msg +} {0 01c134b54ab872941acfce0cf3202f16ee64fb14} + +# ------------------------------------------------------------------------- + +set testfile [makeFile {} sha1[pid].data] + +# pattern repeatcount sha1-hash +set vectors \ + [list \ + 0 "\x00" 81922 a9fb4910179d5088ab606944ca0216e4403a5141 \ + 1 "\x5a" 81920 fef13bbee20792b7b2e65f15d5e4dd6ae04e2323 \ + 2 "\x01\x23\x45\x67\x89\xab\xcd\xef" 2048 \ + 846b9be26036a0b3c16a32805b5f3a85f8d0e0f5 \ + ] + +foreach {n pattern repeat hash} $vectors { + test sha1-7.$n "file hashing" { + list [catch { + set f [open $testfile w] + fconfigure $f -encoding binary -translation binary + puts -nonewline $f [string repeat $pattern $repeat] + close $f + sha1::sha1 -hex -file $testfile + } msg] $msg + } [list 0 $hash] +} + +removeFile $testfile + +# ------------------------------------------------------------------------- + +testsuiteCleanup + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/sha1/sha256.bench b/tcllib/modules/sha1/sha256.bench new file mode 100644 index 0000000..ac1498a --- /dev/null +++ b/tcllib/modules/sha1/sha256.bench @@ -0,0 +1,52 @@ +# -*- tcl -*- +# Tcl Benchmark File +# +# This file contains a number of benchmarks for the 'sha2' 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 sha256 +catch {namespace delete ::sha2} +source [file join [file dirname [info script]] sha256.tcl] + +set key "01234567abcdefgh01234567abcdefgh01234567abcdefgh01234567abcdefgh==" + +# ### ### ### ######### ######### ######### ########################### +## Benchmarks. + +foreach n {1 10 100 1000} { + bench -desc "SHA256 sha_ $n" -pre { + set str [string repeat " " $n] + } -body { + sha2::sha256 $str + } + + bench -desc "SHA224 sha_ $n" -pre { + set str [string repeat " " $n] + } -body { + sha2::sha224 $str + } + + bench -desc "SHA256 hmac $n" -pre { + set str [string repeat " " $n] + } -body { + sha2::hmac $key $str + } +} + +# ### ### ### ######### ######### ######### ########################### +## Complete diff --git a/tcllib/modules/sha1/sha256.c b/tcllib/modules/sha1/sha256.c new file mode 100644 index 0000000..ec5d1d0 --- /dev/null +++ b/tcllib/modules/sha1/sha256.c @@ -0,0 +1,524 @@ +/*- + * Copyright (c) 2001, 2002 Allan Saddi <allan@saddi.com> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * $Id: sha256.c,v 1.3 2007/03/25 11:33:41 patthoyts Exp $ + */ + +/* + * Define WORDS_BIGENDIAN if compiling on a big-endian architecture. + * + * Define SHA256_TEST to test the implementation using the NIST's + * sample messages. The output should be: + * + * ba7816bf 8f01cfea 414140de 5dae2223 b00361a3 96177a9c b410ff61 f20015ad + * 248d6a61 d20638b8 e5c02693 0c3e6039 a33ce459 64ff2167 f6ecedd4 19db06c1 + * cdc76e5c 9914fb92 81a1c7e2 84d73e67 f1809a48 a497200e 046d39cc c7112cd0 + */ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif /* HAVE_CONFIG_H */ + +#if HAVE_INTTYPES_H +# include <inttypes.h> +#else +# if HAVE_STDINT_H +# include <stdint.h> +# endif +#endif + +#include <string.h> +#include <stdlib.h> + +#include "sha256.h" + +#ifndef lint +static const char rcsid[] = + "$Id: sha256.c,v 1.3 2007/03/25 11:33:41 patthoyts Exp $"; +#endif /* !lint */ + +#ifndef TCL_BYTE_ORDER +#error "-DTCL_BYTE_ORDER missing" +#endif + +#if TCL_BYTE_ORDER==1234 +#else +#define WORDS_BIGENDIAN +#endif + + +#define ROTL(x, n) (((x) << (n)) | ((x) >> (32 - (n)))) +#define ROTR(x, n) (((x) >> (n)) | ((x) << (32 - (n)))) + +#define Ch(x, y, z) ((z) ^ ((x) & ((y) ^ (z)))) +#define Maj(x, y, z) (((x) & ((y) | (z))) | ((y) & (z))) +#define SIGMA0(x) (ROTR((x), 2) ^ ROTR((x), 13) ^ ROTR((x), 22)) +#define SIGMA1(x) (ROTR((x), 6) ^ ROTR((x), 11) ^ ROTR((x), 25)) +#define sigma0(x) (ROTR((x), 7) ^ ROTR((x), 18) ^ ((x) >> 3)) +#define sigma1(x) (ROTR((x), 17) ^ ROTR((x), 19) ^ ((x) >> 10)) + +#define DO_ROUND() { \ + t1 = h + SIGMA1(e) + Ch(e, f, g) + *(Kp++) + *(W++); \ + t2 = SIGMA0(a) + Maj(a, b, c); \ + h = g; \ + g = f; \ + f = e; \ + e = d + t1; \ + d = c; \ + c = b; \ + b = a; \ + a = t1 + t2; \ +} + +static const uint32_t K[64] = { + 0x428a2f98L, 0x71374491L, 0xb5c0fbcfL, 0xe9b5dba5L, + 0x3956c25bL, 0x59f111f1L, 0x923f82a4L, 0xab1c5ed5L, + 0xd807aa98L, 0x12835b01L, 0x243185beL, 0x550c7dc3L, + 0x72be5d74L, 0x80deb1feL, 0x9bdc06a7L, 0xc19bf174L, + 0xe49b69c1L, 0xefbe4786L, 0x0fc19dc6L, 0x240ca1ccL, + 0x2de92c6fL, 0x4a7484aaL, 0x5cb0a9dcL, 0x76f988daL, + 0x983e5152L, 0xa831c66dL, 0xb00327c8L, 0xbf597fc7L, + 0xc6e00bf3L, 0xd5a79147L, 0x06ca6351L, 0x14292967L, + 0x27b70a85L, 0x2e1b2138L, 0x4d2c6dfcL, 0x53380d13L, + 0x650a7354L, 0x766a0abbL, 0x81c2c92eL, 0x92722c85L, + 0xa2bfe8a1L, 0xa81a664bL, 0xc24b8b70L, 0xc76c51a3L, + 0xd192e819L, 0xd6990624L, 0xf40e3585L, 0x106aa070L, + 0x19a4c116L, 0x1e376c08L, 0x2748774cL, 0x34b0bcb5L, + 0x391c0cb3L, 0x4ed8aa4aL, 0x5b9cca4fL, 0x682e6ff3L, + 0x748f82eeL, 0x78a5636fL, 0x84c87814L, 0x8cc70208L, + 0x90befffaL, 0xa4506cebL, 0xbef9a3f7L, 0xc67178f2L +}; + +#ifndef RUNTIME_ENDIAN +#ifdef WORDS_BIGENDIAN + +#define BYTESWAP(x) (x) +#define BYTESWAP64(x) (x) + +#else /* !WORDS_BIGENDIAN */ + +#define BYTESWAP(x) ((ROTR((x), 8) & 0xff00ff00L) | \ + (ROTL((x), 8) & 0x00ff00ffL)) + +#define BYTESWAP64(x) _byteswap64(x) + +static +#ifndef _MSC_VER + inline +#endif +uint64_t _byteswap64(uint64_t x) +{ + uint32_t a = x >> 32; + uint32_t b = (uint32_t) x; + return ((uint64_t) BYTESWAP(b) << 32) | (uint64_t) BYTESWAP(a); +} + +#endif /* WORDS_BIGENDIAN */ +#else /* !RUNTIME_ENDIAN */ + +static int littleEndian; + +#define BYTESWAP(x) _byteswap(x) +#define BYTESWAP64(x) _byteswap64(x) + +#define _BYTESWAP(x) ((ROTR((x), 8) & 0xff00ff00L) | \ + (ROTL((x), 8) & 0x00ff00ffL)) +#define _BYTESWAP64(x) __byteswap64(x) + +static inline uint64_t __byteswap64(uint64_t x) +{ + uint32_t a = x >> 32; + uint32_t b = (uint32_t) x; + return ((uint64_t) _BYTESWAP(b) << 32) | (uint64_t) _BYTESWAP(a); +} + +static inline uint32_t _byteswap(uint32_t x) +{ + if (!littleEndian) + return x; + else + return _BYTESWAP(x); +} + +static inline uint64_t _byteswap64(uint64_t x) +{ + if (!littleEndian) + return x; + else + return _BYTESWAP64(x); +} + +static inline void setEndian(void) +{ + union { + uint32_t w; + uint8_t b[4]; + } endian; + + endian.w = 1L; + littleEndian = endian.b[0] != 0; +} + +#endif /* !RUNTIME_ENDIAN */ + +static const uint8_t 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 +}; + +void +SHA256Init (SHA256Context *sc) +{ +#ifdef RUNTIME_ENDIAN + setEndian (); +#endif /* RUNTIME_ENDIAN */ + + sc->totalLength = 0; + sc->hash[0] = 0x6a09e667; + sc->hash[1] = 0xbb67ae85; + sc->hash[2] = 0x3c6ef372; + sc->hash[3] = 0xa54ff53a; + sc->hash[4] = 0x510e527f; + sc->hash[5] = 0x9b05688c; + sc->hash[6] = 0x1f83d9ab; + sc->hash[7] = 0x5be0cd19; + sc->bufferLength = 0; +} + +void +SHA224Init (SHA256Context *sc) +{ +#ifdef RUNTIME_ENDIAN + setEndian (); +#endif /* RUNTIME_ENDIAN */ + + sc->totalLength = 0; + sc->hash[0] = 0xc1059ed8; + sc->hash[1] = 0x367cd507; + sc->hash[2] = 0x3070dd17; + sc->hash[3] = 0xf70e5939; + sc->hash[4] = 0xffc00b31; + sc->hash[5] = 0x68581511; + sc->hash[6] = 0x64f98fa7; + sc->hash[7] = 0xbefa4fa4; + sc->bufferLength = 0; +} + +static void +burnStack (int size) +{ + char buf[128]; + + memset (buf, 0, sizeof (buf)); + size -= sizeof (buf); + if (size > 0) + burnStack (size); +} + +static void +SHA256Guts (SHA256Context *sc, const uint32_t *cbuf) +{ + uint32_t buf[64]; + uint32_t *W, *W2, *W7, *W15, *W16; + uint32_t a, b, c, d, e, f, g, h; + uint32_t t1, t2; + const uint32_t *Kp; + int i; + + W = buf; + + for (i = 15; i >= 0; i--) { + *(W++) = BYTESWAP(*cbuf); + cbuf++; + } + + W16 = &buf[0]; + W15 = &buf[1]; + W7 = &buf[9]; + W2 = &buf[14]; + + for (i = 47; i >= 0; i--) { + *(W++) = sigma1(*W2) + *(W7++) + sigma0(*W15) + *(W16++); + W2++; + W15++; + } + + a = sc->hash[0]; + b = sc->hash[1]; + c = sc->hash[2]; + d = sc->hash[3]; + e = sc->hash[4]; + f = sc->hash[5]; + g = sc->hash[6]; + h = sc->hash[7]; + + Kp = K; + W = buf; + +#ifndef SHA256_UNROLL +#define SHA256_UNROLL 1 +#endif /* !SHA256_UNROLL */ + +#if SHA256_UNROLL == 1 + for (i = 63; i >= 0; i--) + DO_ROUND(); +#elif SHA256_UNROLL == 2 + for (i = 31; i >= 0; i--) { + DO_ROUND(); DO_ROUND(); + } +#elif SHA256_UNROLL == 4 + for (i = 15; i >= 0; i--) { + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + } +#elif SHA256_UNROLL == 8 + for (i = 7; i >= 0; i--) { + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + } +#elif SHA256_UNROLL == 16 + for (i = 3; i >= 0; i--) { + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + } +#elif SHA256_UNROLL == 32 + for (i = 1; i >= 0; i--) { + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + } +#elif SHA256_UNROLL == 64 + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); + DO_ROUND(); DO_ROUND(); DO_ROUND(); DO_ROUND(); +#else +#error "SHA256_UNROLL must be 1, 2, 4, 8, 16, 32, or 64!" +#endif + + sc->hash[0] += a; + sc->hash[1] += b; + sc->hash[2] += c; + sc->hash[3] += d; + sc->hash[4] += e; + sc->hash[5] += f; + sc->hash[6] += g; + sc->hash[7] += h; +} + +void +SHA256Update (SHA256Context *sc, const void *data, uint32_t len) +{ + uint32_t bufferBytesLeft; + uint32_t bytesToCopy; + int needBurn = 0; + + /* gcc 4 complains that the following construction has an invalid lvalue: + * ((uint8_t *) data) += bytesToCopy; + * apparently they have decided that assigment to cast values is a bad idea + * so we have to do the cast now as a work around -- assholes. + */ + uint8_t *dataPtr = (uint8_t *)data; + +#ifdef SHA256_FAST_COPY + if (sc->bufferLength) { + bufferBytesLeft = 64L - sc->bufferLength; + + bytesToCopy = bufferBytesLeft; + if (bytesToCopy > len) + bytesToCopy = len; + + memcpy (&sc->buffer.bytes[sc->bufferLength], dataPtr, bytesToCopy); + + sc->totalLength += bytesToCopy * 8L; + + sc->bufferLength += bytesToCopy; + dataPtr += bytesToCopy; + len -= bytesToCopy; + + if (sc->bufferLength == 64L) { + SHA256Guts (sc, sc->buffer.words); + needBurn = 1; + sc->bufferLength = 0L; + } + } + + while (len > 63L) { + sc->totalLength += 512L; + + SHA256Guts (sc, dataPtr); + needBurn = 1; + + dataPtr += 64L; + len -= 64L; + } + + if (len) { + memcpy (&sc->buffer.bytes[sc->bufferLength], dataPtr, len); + + sc->totalLength += len * 8L; + + sc->bufferLength += len; + } +#else /* SHA256_FAST_COPY */ + while (len) { + bufferBytesLeft = 64L - sc->bufferLength; + + bytesToCopy = bufferBytesLeft; + if (bytesToCopy > len) + bytesToCopy = len; + + memcpy (&sc->buffer.bytes[sc->bufferLength], dataPtr, bytesToCopy); + + sc->totalLength += bytesToCopy * 8L; + + sc->bufferLength += bytesToCopy; + + dataPtr += bytesToCopy; + len -= bytesToCopy; + + if (sc->bufferLength == 64L) { + SHA256Guts (sc, sc->buffer.words); + needBurn = 1; + sc->bufferLength = 0L; + } + } +#endif /* SHA256_FAST_COPY */ + + if (needBurn) + burnStack (sizeof (uint32_t[74]) + sizeof (uint32_t *[6]) + sizeof (int)); +} + +void +SHA256Final ( +SHA256Context *sc, uint8_t hash[SHA256_HASH_SIZE]) +{ + uint32_t bytesToPad; + uint64_t lengthPad; + int i; + + bytesToPad = 120L - sc->bufferLength; + if (bytesToPad > 64L) + bytesToPad -= 64L; + + lengthPad = BYTESWAP64(sc->totalLength); + + SHA256Update (sc, padding, bytesToPad); + SHA256Update (sc, &lengthPad, 8L); + + if (hash) { + for (i = 0; i < SHA256_HASH_WORDS; i++) { +#ifdef SHA256_FAST_COPY + *((uint32_t *) hash) = BYTESWAP(sc->hash[i]); +#else /* SHA256_FAST_COPY */ + hash[0] = (uint8_t) (sc->hash[i] >> 24); + hash[1] = (uint8_t) (sc->hash[i] >> 16); + hash[2] = (uint8_t) (sc->hash[i] >> 8); + hash[3] = (uint8_t) sc->hash[i]; +#endif /* SHA256_FAST_COPY */ + hash += 4; + } + } +} + +#ifdef SHA256_TEST + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +int +main (int argc, char *argv[]) +{ + SHA256Context foo; + uint8_t hash[SHA256_HASH_SIZE]; + char buf[1000]; + int i; + + SHA256Init (&foo); + SHA256Update (&foo, "abc", 3); + SHA256Final (&foo, hash); + + for (i = 0; i < SHA256_HASH_SIZE;) { + printf ("%02x", hash[i++]); + if (!(i % 4)) + printf (" "); + } + printf ("\n"); + + SHA256Init (&foo); + SHA256Update (&foo, + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", + 56); + SHA256Final (&foo, hash); + + for (i = 0; i < SHA256_HASH_SIZE;) { + printf ("%02x", hash[i++]); + if (!(i % 4)) + printf (" "); + } + printf ("\n"); + + SHA256Init (&foo); + memset (buf, 'a', sizeof (buf)); + for (i = 0; i < 1000; i++) + SHA256Update (&foo, buf, sizeof (buf)); + SHA256Final (&foo, hash); + + for (i = 0; i < SHA256_HASH_SIZE;) { + printf ("%02x", hash[i++]); + if (!(i % 4)) + printf (" "); + } + printf ("\n"); + + exit (0); +} + +#endif /* SHA256_TEST */ diff --git a/tcllib/modules/sha1/sha256.h b/tcllib/modules/sha1/sha256.h new file mode 100644 index 0000000..c10d2f2 --- /dev/null +++ b/tcllib/modules/sha1/sha256.h @@ -0,0 +1,83 @@ +/*- + * Copyright (c) 2001, 2002 Allan Saddi <allan@saddi.com> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * $Id: sha256.h,v 1.4 2011/04/21 17:51:55 andreas_kupries Exp $ + */ + +#ifndef _SHA256_H +#define _SHA256_H + +#if HAVE_INTTYPES_H +# include <inttypes.h> +#else +# if HAVE_STDINT_H +# include <stdint.h> +# endif +#endif + +#define SHA256_HASH_SIZE 32 + +/* Hash size in 32-bit words */ +#define SHA256_HASH_WORDS 8 + +#ifdef _MSC_VER +typedef unsigned __int64 uint64_t; +#elif !(defined(__hpux) || defined(_AIX)) +typedef unsigned long long uint64_t; +#endif + +#if !(defined(__hpux)) +typedef unsigned int uint32_t; +typedef unsigned char uint8_t; +#endif + +struct _SHA256Context { + uint64_t totalLength; + uint32_t hash[SHA256_HASH_WORDS]; + uint32_t bufferLength; + union { + uint32_t words[16]; + uint8_t bytes[64]; + } buffer; +}; + +typedef struct _SHA256Context SHA256Context; +typedef struct _SHA256Context SHA256_CTX; + +#ifdef __cplusplus +extern "C" { +#endif + +void SHA256Init (SHA256Context *sc); +void SHA256Update (SHA256Context *sc, const void *data, uint32_t len); +void SHA256Final (SHA256Context *sc, uint8_t hash[SHA256_HASH_SIZE]); + +void SHA224Init (SHA256Context *sc); + +#ifdef __cplusplus +} +#endif + +#endif /* !_SHA256_H */ diff --git a/tcllib/modules/sha1/sha256.man b/tcllib/modules/sha1/sha256.man new file mode 100644 index 0000000..b11e5e0 --- /dev/null +++ b/tcllib/modules/sha1/sha256.man @@ -0,0 +1,194 @@ +[manpage_begin sha256 n 1.0.3] +[see_also md4] +[see_also md5] +[see_also ripemd128] +[see_also ripemd160] +[see_also sha1] +[keywords {FIPS 180-1}] +[keywords hashing] +[keywords message-digest] +[keywords {rfc 2104}] +[keywords security] +[keywords sha256] +[moddesc {SHA-x Message-Digest Algorithm}] +[copyright {2008, Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[titledesc {SHA256 Message-Digest Algorithm}] +[category {Hashes, checksums, and encryption}] +[require Tcl 8.2] +[require sha256 [opt 1.0.3]] +[description] +[para] + +This package provides an implementation in Tcl of the SHA256 and +SHA224 message-digest algorithms as specified by FIPS PUB 180-1 +(1). These algorithms take a message and generates a 256-bit (224-bit) +digest from the input. The SHA2 algorithms are related to the SHA1 +algorithm. + +[para] + +This package also includes support for creating keyed message-digests +using the HMAC algorithm from RFC 2104 (3) with SHA256 as the +message-digest. + +[section {COMMANDS}] + +[list_begin definitions] + +[call [cmd ::sha2::sha256] \ + [opt "[option -hex|-bin]"] \ + [lb] [option "-channel channel"] | \ + [option "-file filename"] | [opt [option --]] [arg "string"] [rb]] + +The command takes a message and returns the SHA256 digest of this +message as a hexadecimal string. You may request the result as binary +data by giving [arg "-bin"]. + +[para] + +The data to be hashed can be specified either as a string argument to +the [cmd "sha256"] 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. [emph NOTE] use of the channel or filename +options results in the internal use of [cmd vwait]. To avoid nested +event loops in Tk or tclhttpd applications you should use the +incremental programming API (see below). + +[para] + +Only one of [arg "-file"], [arg "-channel"] or [arg "string"] should be given. + +[para] If the [arg string] to hash can be mistaken for an option +(leading dash "-"), use the option [option --] before it to terminate +option processing and force interpretation as a string. + + +[call [cmd ::sha2::sha224] \ + [opt "[option -hex|-bin]"] \ + [lb] [option "-channel channel"] | \ + [option "-file filename"] | [opt [option --]] [arg "string"] [rb]] + +Like [cmd ::sha2::sha256], except that the SHA224 digest is returned. + +[call [cmd "::sha2::hmac"] [arg "key"] [arg "string"]] +[call [cmd "::sha2::hmac"] \ + [opt "[option -hex|-bin]"] \ + [option "-key key"] \ + [lb] [option "-channel channel"] | \ + [option "-file filename"] | [opt [option --]] [arg "string"] [rb]] + +Calculate an Hashed Message Authentication digest (HMAC) using the +SHA256 digest algorithm. HMACs are described in RFC 2104 (3) and +provide an SHA256 digest that includes a key. All options other than +[arg -key] are as for the [cmd "::sha2::sha256"] command. + +[para] If the [arg string] to hash can be mistaken for an option +(leading dash "-"), use the option [option --] before it to terminate +option processing and force interpretation as a string. + +[list_end] + +[section {PROGRAMMING INTERFACE}] + +For the programmer, the SHA256 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 SHA256 hash operates on a token +(equivalent to the bucket). You call [cmd "SHA256Init"] to obtain a +token and then call [cmd "SHA256Update"] as many times as required to +add data to the hash. To release any resources and obtain the hash +value, you then call [cmd "SHA256Final"]. An equivalent set of +functions gives you a keyed digest (HMAC). + +[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. Failing that there is a pure-tcl +equivalent. The programming interface remains the same in all cases. + +[list_begin definitions] + +[call [cmd "::sha2::SHA256Init"]] +[call [cmd "::sha2::SHA224Init"]] + +Begins a new SHA256/SHA224 hash. Returns a token ID that must be used +for the remaining functions. + +[call [cmd "::sha2::SHA256Update"] [arg "token"] [arg "data"]] + +Add data to the hash identified by token. Calling +[emph {SHA256Update $token "abcd"}] is equivalent to calling +[emph {SHA256Update $token "ab"}] followed by +[emph {SHA256Update $token "cb"}]. See [sectref {EXAMPLES}]. + +Note that this command is used for both SHA256 and SHA224. Only the +initialization and finalization commands of both hashes differ. + +[call [cmd "::sha2::SHA256Final"] [arg "token"]] +[call [cmd "::sha2::SHA224Final"] [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 32/28 bytes representing the 256/224 bit +SHA256 / SHA224 digest value. + +[call [cmd "::sha2::HMACInit"] [arg "key"]] + +This is equivalent to the [cmd "::sha2::SHA256Init"] command except +that it requires the key that will be included in the HMAC. + +[call [cmd "::sha2::HMACUpdate"] [arg "token"] [arg "data"]] +[call [cmd "::sha2::HMACFinal"] [arg "token"]] + +These commands are identical to the SHA256 equivalent commands. + +[list_end] + +[section {EXAMPLES}] + +[example { +% sha2::sha256 "Tcl does SHA256" +0b91043ee484abd83c3e4b08d6034d71b937026379f0f59bda6e625e6e214789 +}] + +[example { +% sha2::hmac Sekret "Tcl does SHA256" +4f9352c64d655e8a36abe73e6163a9d7a54039877c1c92ec90b07d48d4e854e0 +}] + +[example { +% set tok [sha2::SHA256Init] +::sha2::1 +% sha2::SHA256Update $tok "Tcl " +% sha2::SHA256Update $tok "does " +% sha2::SHA256Update $tok "SHA256" +% sha2::Hex [sha2::SHA256Final $tok] +0b91043ee484abd83c3e4b08d6034d71b937026379f0f59bda6e625e6e214789 +}] + +[section {REFERENCES}] + +[list_begin enumerated] + +[enum] + "Secure Hash Standard", National Institute of Standards + and Technology, U.S. Department Of Commerce, April 1995. + ([uri http://www.itl.nist.gov/fipspubs/fip180-1.htm]) + +[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 sha1] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/sha1/sha256.tcl b/tcllib/modules/sha1/sha256.tcl new file mode 100644 index 0000000..cb365a5 --- /dev/null +++ b/tcllib/modules/sha1/sha256.tcl @@ -0,0 +1,832 @@ +# sha256.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# SHA1 defined by FIPS 180-2, "The Secure Hash Standard" +# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" +# +# This is an implementation of the secure hash algorithms specified in the +# FIPS 180-2 document. +# +# This implementation permits incremental updating of the hash and +# provides support for external compiled implementations using critcl. +# +# This implementation permits incremental updating of the hash and +# provides support for external compiled implementations either using +# critcl (sha256c). +# +# Ref: http://csrc.nist.gov/publications/fips/fips180-2/fips180-2.pdf +# http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- +# @mdgen EXCLUDE: sha256c.tcl + +package require Tcl 8.2; # tcl minimum version + +namespace eval ::sha2 { + variable accel + array set accel {tcl 0 critcl 0} + variable loaded {} + + namespace export sha256 hmac \ + SHA256Init SHA256Update SHA256Final + + variable uid + if {![info exists uid]} { + set uid 0 + } + + variable K + if {![info exists K]} { + # FIPS 180-2: 4.2.2 SHA-256 constants + set K [list \ + 0x428a2f98 0x71374491 0xb5c0fbcf 0xe9b5dba5 \ + 0x3956c25b 0x59f111f1 0x923f82a4 0xab1c5ed5 \ + 0xd807aa98 0x12835b01 0x243185be 0x550c7dc3 \ + 0x72be5d74 0x80deb1fe 0x9bdc06a7 0xc19bf174 \ + 0xe49b69c1 0xefbe4786 0x0fc19dc6 0x240ca1cc \ + 0x2de92c6f 0x4a7484aa 0x5cb0a9dc 0x76f988da \ + 0x983e5152 0xa831c66d 0xb00327c8 0xbf597fc7 \ + 0xc6e00bf3 0xd5a79147 0x06ca6351 0x14292967 \ + 0x27b70a85 0x2e1b2138 0x4d2c6dfc 0x53380d13 \ + 0x650a7354 0x766a0abb 0x81c2c92e 0x92722c85 \ + 0xa2bfe8a1 0xa81a664b 0xc24b8b70 0xc76c51a3 \ + 0xd192e819 0xd6990624 0xf40e3585 0x106aa070 \ + 0x19a4c116 0x1e376c08 0x2748774c 0x34b0bcb5 \ + 0x391c0cb3 0x4ed8aa4a 0x5b9cca4f 0x682e6ff3 \ + 0x748f82ee 0x78a5636f 0x84c87814 0x8cc70208 \ + 0x90befffa 0xa4506ceb 0xbef9a3f7 0xc67178f2 \ + ] + } + +} + +# ------------------------------------------------------------------------- +# Management of sha256 implementations. + +# 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 ::sha2::LoadAccelerator {name} { + variable accel + set r 0 + switch -exact -- $name { + tcl { + # Already present (this file) + set r 1 + } + critcl { + if {![catch {package require tcllibc}] + || ![catch {package require sha256c}]} { + set r [expr {[info commands ::sha2::sha256c_update] != {}}] + } + } + default { + return -code error "invalid accelerator $key:\ + must be one of [join [KnownImplementations] {, }]" + } + } + set accel($name) $r + return $r +} + +# ::sha2::Implementations -- +# +# Determines which implementations are +# present, i.e. loaded. +# +# Arguments: +# None. +# +# Results: +# A list of implementation keys. + +proc ::sha2::Implementations {} { + variable accel + set res {} + foreach n [array names accel] { + if {!$accel($n)} continue + lappend res $n + } + return $res +} + +# ::sha2::KnownImplementations -- +# +# Determines which implementations are known +# as possible implementations. +# +# Arguments: +# None. +# +# Results: +# A list of implementation keys. In the order +# of preference, most prefered first. + +proc ::sha2::KnownImplementations {} { + return {critcl tcl} +} + +proc ::sha2::Names {} { + return { + critcl {tcllibc based} + tcl {pure Tcl} + } +} + +# ::sha2::SwitchTo -- +# +# Activates a loaded named implementation. +# +# Arguments: +# key Name of the implementation to activate. +# +# Results: +# None. + +proc ::sha2::SwitchTo {key} { + variable accel + variable loaded + + if {[string equal $key $loaded]} { + # No change, nothing to do. + return + } elseif {![string equal $key ""]} { + # Validate the target implementation of the switch. + + if {![info exists accel($key)]} { + return -code error "Unable to activate unknown implementation \"$key\"" + } elseif {![info exists accel($key)] || !$accel($key)} { + return -code error "Unable to activate missing implementation \"$key\"" + } + } + + # Deactivate the previous implementation, if there was any. + + if {![string equal $loaded ""]} { + foreach c { + SHA256Init SHA224Init + SHA256Final SHA224Final + SHA256Update + } { + rename ::sha2::$c ::sha2::${c}-${loaded} + } + } + + # Activate the new implementation, if there is any. + + if {![string equal $key ""]} { + foreach c { + SHA256Init SHA224Init + SHA256Final SHA224Final + SHA256Update + } { + rename ::sha2::${c}-${key} ::sha2::$c + } + } + + # Remember the active implementation, for deactivation by future + # switches. + + set loaded $key + return +} + +# ------------------------------------------------------------------------- + +# SHA256Init -- +# +# Create and initialize an SHA256 state variable. This will be +# cleaned up when we call SHA256Final +# + +proc ::sha2::SHA256Init-tcl {} { + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token tok + + # FIPS 180-2: 5.3.2 Setting the initial hash value + array set tok \ + [list \ + A [expr {int(0x6a09e667)}] \ + B [expr {int(0xbb67ae85)}] \ + C [expr {int(0x3c6ef372)}] \ + D [expr {int(0xa54ff53a)}] \ + E [expr {int(0x510e527f)}] \ + F [expr {int(0x9b05688c)}] \ + G [expr {int(0x1f83d9ab)}] \ + H [expr {int(0x5be0cd19)}] \ + n 0 i "" v 256] + return $token +} + +proc ::sha2::SHA256Init-critcl {} { + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token tok + + # FIPS 180-2: 5.3.2 Setting the initial hash value + set tok(sha256c) [sha256c_init256] + return $token +} + +# SHA256Update -- +# +# 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 ::sha2::SHA256Update-tcl {token data} { + upvar #0 $token state + + # 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} {} { + SHA256Transform $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 ::sha2::SHA256Update-critcl {token data} { + upvar #0 $token state + + set state(sha256c) [sha256c_update $data $state(sha256c)] + return +} + +# SHA256Final -- +# +# 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 256 bits represented as binary data. +# + +proc ::sha2::SHA256Final-tcl {token} { + upvar #0 $token state + SHA256Penultimate $token + + # Output + set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)][bytes $state(F)][bytes $state(G)][bytes $state(H)] + unset state + return $r +} + +proc ::sha2::SHA256Final-critcl {token} { + upvar #0 $token state + set r $state(sha256c) + unset state + return $r +} + +# SHA256Penultimate -- +# +# +proc ::sha2::SHA256Penultimate {token} { + upvar #0 $token state + + # FIPS 180-2: 5.1.1: Padding the message + # + 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] + + # Append length in bits as big-endian wide int. + set dlen [expr {8 * $state(n)}] + append state(i) [binary format II 0 $dlen] + + # Calculate the hash for the remaining block. + set len [string length $state(i)] + for {set n 0} {($n + 64) <= $len} {} { + SHA256Transform $token [string range $state(i) $n [incr n 64]] + } +} + +# ------------------------------------------------------------------------- + +proc ::sha2::SHA224Init-tcl {} { + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token tok + + # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values + array set tok \ + [list \ + A [expr {int(0xc1059ed8)}] \ + B [expr {int(0x367cd507)}] \ + C [expr {int(0x3070dd17)}] \ + D [expr {int(0xf70e5939)}] \ + E [expr {int(0xffc00b31)}] \ + F [expr {int(0x68581511)}] \ + G [expr {int(0x64f98fa7)}] \ + H [expr {int(0xbefa4fa4)}] \ + n 0 i "" v 224] + return $token +} + +proc ::sha2::SHA224Init-critcl {} { + variable uid + set token [namespace current]::[incr uid] + upvar #0 $token tok + + # FIPS 180-2 (change notice 1) (1): SHA-224 initialization values + set tok(sha256c) [sha256c_init224] + return $token +} + +interp alias {} ::sha2::SHA224Update {} ::sha2::SHA256Update + +proc ::sha2::SHA224Final-tcl {token} { + upvar #0 $token state + SHA256Penultimate $token + + # Output + set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)][bytes $state(F)][bytes $state(G)] + unset state + return $r +} + +proc ::sha2::SHA224Final-critcl {token} { + upvar #0 $token state + # Trim result down to 224 bits (by 4 bytes). + # See output below, A..G, not A..H + set r [string range $state(sha256c) 0 end-4] + 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 SHA1Init procedure except that a key is +# added into the algorithm +# +proc ::sha2::HMACInit {K} { + + # Key K is adjusted to be 64 bytes long. If K is larger, then use + # the SHA1 digest of K and pad this instead. + set len [string length $K] + if {$len > 64} { + set tok [SHA256Init] + SHA256Update $tok $K + set K [SHA256Final $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 [SHA256Init] + SHA256Update $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 SHA256Update +# +proc ::sha2::HMACUpdate {token data} { + SHA256Update $token $data + return +} + +# HMACFinal -- +# +# This is equivalent to the SHA256Final procedure. The hash context is +# closed and the binary representation of the hash result is returned. +# +proc ::sha2::HMACFinal {token} { + upvar #0 $token state + + set tok [SHA256Init]; # init the outer hashing function + SHA256Update $tok $state(Ko); # prepare with the outer pad. + SHA256Update $tok [SHA256Final $token]; # hash the inner result + return [SHA256Final $tok] +} + +# ------------------------------------------------------------------------- +# Description: +# This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but +# includes an extra round and a set of constant modifiers throughout. +# +set ::sha2::SHA256Transform_body { + variable K + upvar #0 $token state + + # FIPS 180-2: 6.2.2 SHA-256 Hash computation. + binary scan $msg I* blocks + set blockLen [llength $blocks] + for {set i 0} {$i < $blockLen} {incr i 16} { + set W [lrange $blocks $i [expr {$i+15}]] + + # FIPS 180-2: 6.2.2 (1) Prepare the message schedule + # For t = 16 to 64 + # let Wt = (sigma1(Wt-2) + Wt-7 + sigma0(Wt-15) + Wt-16) + set t2 13 + set t7 8 + set t15 0 + set t16 -1 + for {set t 16} {$t < 64} {incr t} { + lappend W [expr {([sigma1 [lindex $W [incr t2]]] \ + + [lindex $W [incr t7]] \ + + [sigma0 [lindex $W [incr t15]]] \ + + [lindex $W [incr t16]]) & 0xffffffff}] + } + + # FIPS 180-2: 6.2.2 (2) Initialise the working variables + set A $state(A) + set B $state(B) + set C $state(C) + set D $state(D) + set E $state(E) + set F $state(F) + set G $state(G) + set H $state(H) + + # FIPS 180-2: 6.2.2 (3) Do permutation rounds + # For t = 0 to 63 do + # T1 = h + SIGMA1(e) + Ch(e,f,g) + Kt + Wt + # T2 = SIGMA0(a) + Maj(a,b,c) + # h = g; g = f; f = e; e = d + T1; d = c; c = b; b = a; + # a = T1 + T2 + # + for {set t 0} {$t < 64} {incr t} { + set T1 [expr {($H + [SIGMA1 $E] + [Ch $E $F $G] + + [lindex $K $t] + [lindex $W $t]) & 0xffffffff}] + set T2 [expr {([SIGMA0 $A] + [Maj $A $B $C]) & 0xffffffff}] + set H $G + set G $F + set F $E + set E [expr {($D + $T1) & 0xffffffff}] + set D $C + set C $B + set B $A + set A [expr {($T1 + $T2) & 0xffffffff}] + } + + # FIPS 180-2: 6.2.2 (4) Compute the intermediate hash + incr state(A) $A + incr state(B) $B + incr state(C) $C + incr state(D) $D + incr state(E) $E + incr state(F) $F + incr state(G) $G + incr state(H) $H + } + + return +} + +# ------------------------------------------------------------------------- + +# FIPS 180-2: 4.1.2 equation 4.2 +proc ::sha2::Ch {x y z} { + return [expr {($x & $y) ^ (~$x & $z)}] +} + +# FIPS 180-2: 4.1.2 equation 4.3 +proc ::sha2::Maj {x y z} { + return [expr {($x & $y) ^ ($x & $z) ^ ($y & $z)}] +} + +# FIPS 180-2: 4.1.2 equation 4.4 +# (x >>> 2) ^ (x >>> 13) ^ (x >>> 22) +proc ::sha2::SIGMA0 {x} { + return [expr {[>>> $x 2] ^ [>>> $x 13] ^ [>>> $x 22]}] +} + +# FIPS 180-2: 4.1.2 equation 4.5 +# (x >>> 6) ^ (x >>> 11) ^ (x >>> 25) +proc ::sha2::SIGMA1 {x} { + return [expr {[>>> $x 6] ^ [>>> $x 11] ^ [>>> $x 25]}] +} + +# FIPS 180-2: 4.1.2 equation 4.6 +# s0 = (x >>> 7) ^ (x >>> 18) ^ (x >> 3) +proc ::sha2::sigma0 {x} { + #return [expr {[>>> $x 7] ^ [>>> $x 18] ^ (($x >> 3) & 0x1fffffff)}] + return [expr {((($x<<25) | (($x>>7) & (0x7FFFFFFF>>6))) \ + ^ (($x<<14) | (($x>>18) & (0x7FFFFFFF>>17))) & 0xFFFFFFFF) \ + ^ (($x>>3) & 0x1fffffff)}] +} + +# FIPS 180-2: 4.1.2 equation 4.7 +# s1 = (x >>> 17) ^ (x >>> 19) ^ (x >> 10) +proc ::sha2::sigma1 {x} { + #return [expr {[>>> $x 17] ^ [>>> $x 19] ^ (($x >> 10) & 0x003fffff)}] + return [expr {((($x<<15) | (($x>>17) & (0x7FFFFFFF>>16))) \ + ^ (($x<<13) | (($x>>19) & (0x7FFFFFFF>>18))) & 0xFFFFFFFF) \ + ^ (($x >> 10) & 0x003fffff)}] +} + +# 32bit rotate-right +proc ::sha2::>>> {v n} { + return [expr {(($v << (32 - $n)) \ + | (($v >> $n) & (0x7FFFFFFF >> ($n - 1)))) \ + & 0xFFFFFFFF}] +} + +# 32bit rotate-left +proc ::sha2::<<< {v n} { + return [expr {((($v << $n) \ + | (($v >> (32 - $n)) \ + & (0x7FFFFFFF >> (31 - $n))))) \ + & 0xFFFFFFFF}] +} + +# ------------------------------------------------------------------------- +# We speed up the SHA256Transform code while maintaining readability in the +# source code by substituting inline for a number of functions. +# The idea is to reduce the number of [expr] calls. + +# Inline the Ch function +regsub -all -line \ + {\[Ch (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \ + $::sha2::SHA256Transform_body \ + {((\1 \& \2) ^ ((~\1) \& \3))} \ + ::sha2::SHA256Transform_body + +# Inline the Maj function +regsub -all -line \ + {\[Maj (\$[ABCDEFGH]) (\$[ABCDEFGH]) (\$[ABCDEFGH])\]} \ + $::sha2::SHA256Transform_body \ + {((\1 \& \2) ^ (\1 \& \3) ^ (\2 \& \3))} \ + ::sha2::SHA256Transform_body + + +# Inline the SIGMA0 function +regsub -all -line \ + {\[SIGMA0 (\$[ABCDEFGH])\]} \ + $::sha2::SHA256Transform_body \ + {((((\1<<30) | ((\1>>2) \& (0x7FFFFFFF>>1))) \& 0xFFFFFFFF) \ + ^ (((\1<<19) | ((\1>>13) \& (0x7FFFFFFF>>12))) \& 0xFFFFFFFF) \ + ^ (((\1<<10) | ((\1>>22) \& (0x7FFFFFFF>>21))) \& 0xFFFFFFFF) \ + )} \ + ::sha2::SHA256Transform_body + +# Inline the SIGMA1 function +regsub -all -line \ + {\[SIGMA1 (\$[ABCDEFGH])\]} \ + $::sha2::SHA256Transform_body \ + {((((\1<<26) | ((\1>>6) \& (0x7FFFFFFF>>5))) \& 0xFFFFFFFF) \ + ^ (((\1<<21) | ((\1>>11) \& (0x7FFFFFFF>>10))) \& 0xFFFFFFFF) \ + ^ (((\1<<7) | ((\1>>25) \& (0x7FFFFFFF>>24))) \& 0xFFFFFFFF) \ + )} \ + ::sha2::SHA256Transform_body + +proc ::sha2::SHA256Transform {token msg} $::sha2::SHA256Transform_body + +# ------------------------------------------------------------------------- + +# Convert a integer value into a binary string in big-endian order. +proc ::sha2::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} +proc ::sha2::bytes {v} { + #format %c%c%c%c [byte 3 $v] [byte 2 $v] [byte 1 $v] [byte 0 $v] + format %c%c%c%c \ + [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \ + [expr {(0xFF0000 & $v) >> 16}] \ + [expr {(0xFF00 & $v) >> 8}] \ + [expr {0xFF & $v}] +} + +# ------------------------------------------------------------------------- + +proc ::sha2::Hex {data} { + binary scan $data H* result + return $result +} + +# ------------------------------------------------------------------------- + +# Description: +# Pop the nth element off a list. Used in options processing. +# +proc ::sha2::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 ::sha2::Chunk {token channel {chunksize 4096}} { + upvar #0 $token state + + if {[eof $channel]} { + fileevent $channel readable {} + set state(reading) 0 + } + + SHA256Update $token [read $channel $chunksize] +} + +# ------------------------------------------------------------------------- + +proc ::sha2::_sha256 {ver args} { + array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} + if {[llength $args] == 1} { + set opts(-hex) 1 + } else { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 [concat -bin [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\ + \"[namespace current]::sha$ver ?-hex|-bin? -filename file\ + | -channel channel | string\"" + } + set tok [SHA${ver}Init] + SHA${ver}Update $tok [lindex $args 0] + set r [SHA${ver}Final $tok] + + } else { + + set tok [SHA${ver}Init] + # FRINK: nocheck + set [subst $tok](reading) 1 + fileevent $opts(-channel) readable \ + [list [namespace origin Chunk] \ + $tok $opts(-channel) $opts(-chunksize)] + # FRINK: nocheck + vwait [subst $tok](reading) + set r [SHA${ver}Final $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 +} + +interp alias {} ::sha2::sha256 {} ::sha2::_sha256 256 +interp alias {} ::sha2::sha224 {} ::sha2::_sha256 224 + +# ------------------------------------------------------------------------- + +proc ::sha2::hmac {args} { + array set opts {-hex 1 -filename {} -channel {} -chunksize 4096} + if {[llength $args] != 2} { + while {[string match -* [set option [lindex $args 0]]]} { + switch -glob -- $option { + -key { set opts(-key) [Pop args 1] } + -hex { set opts(-hex) 1 } + -bin { set opts(-hex) 0 } + -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 {[llength $args] == 2} { + set opts(-key) [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)] + # FRINK: nocheck + 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 ::sha2 { + variable e {} + foreach e [KnownImplementations] { + if {[LoadAccelerator $e]} { + SwitchTo $e + break + } + } + unset e +} + +package provide sha256 1.0.3 + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/sha1/sha256.test b/tcllib/modules/sha1/sha256.test new file mode 100644 index 0000000..be625f6 --- /dev/null +++ b/tcllib/modules/sha1/sha256.test @@ -0,0 +1,97 @@ +# -*- tcl -*- +# sha256.test: tests for the sha256 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. +# +# RCS: @(#) $Id: sha256.test,v 1.6 2006/10/13 06:23:29 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 { + if {[useTcllibC]} { + useLocalKeep sha256.tcl sha256 ::sha2 + } else { + useLocal sha256.tcl sha256 ::sha2 + } + TestAccelInit ::sha2 +} + +# ------------------------------------------------------------------------- +# Now the package specific tests.... +# ------------------------------------------------------------------------- + +test sha256-1.0 {sha256 usage} { + catch {::sha2::sha256} result + set result +} "wrong # args: should be \"::sha2::sha256 ?-hex|-bin? -filename file | -channel channel | string\"" + +test sha224-1.0 {sha224 usage} { + catch {::sha2::sha224} result + set result +} "wrong # args: should be \"::sha2::sha224 ?-hex|-bin? -filename file | -channel channel | string\"" + +# ------------------------------------------------------------------------- +# Digest + +# FIPS 180-2 test vectors SHA-256 +set vectorsD \ + [list \ + "abc" \ + "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" \ + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" \ + "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1" \ + [string repeat a 1000000] \ + "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0" \ + \ + "x" 2d711642b726b04401627ca9fbac32f5c8530fb1903cc4db02258717921a4881 \ + ] + +# FIPS 180-2 test vectors SHA-224 +set vectorsDT \ + [list \ + "abc" \ + "23097d223405d8228642a477bda255b32aadbce4bda0b3f7e36c9da7" \ + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" \ + "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" \ + [string repeat a 1000000] \ + "20794655980c91d8bbb4c1ea97618a4bf03f42581948b2ee4ee7ad67" ] + +# ------------------------------------------------------------------------- + +TestAccelDo sha2 impl { + set n 0 + foreach {msg hash} $vectorsD { + test sha256-${impl}-2.$n {FIPS-180-2 test vectors for SHA-256} { + list [catch {::sha2::sha256 $msg} r] $r + } [list 0 $hash] ; # {} + incr n + } + + set n 0 + foreach {msg hash} $vectorsDT { + test sha224-${impl}-2.$n {FIPS-180-2 test vectors for SHA-224} { + list [catch {::sha2::sha224 $msg} r] $r + } [list 0 $hash] ; # {} + incr n + } +} + +# ------------------------------------------------------------------------- + +TestAccelExit sha2 +testsuiteCleanup + +# ------------------------------------------------------------------------- +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tcllib/modules/sha1/sha256c.tcl b/tcllib/modules/sha1/sha256c.tcl new file mode 100644 index 0000000..b27e038 --- /dev/null +++ b/tcllib/modules/sha1/sha256c.tcl @@ -0,0 +1,174 @@ +# sha256c.tcl +# - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> +# - Copyright (C) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# (Rewriting the sha1c wrapper to 256). +# +# Wrapper for the Secure Hashing Algorithm (SHA256) +# +# $Id: sha256c.tcl,v 1.5 2009/05/07 00:35:10 patthoyts Exp $ + +package require critcl; # needs critcl +# @sak notprovided sha256c +package provide sha256c 1.0.2 + +critcl::cheaders sha256.h; # FreeBSD SHA256 implementation +critcl::csources sha256.c; # FreeBSD SHA256 implementation + +if {$tcl_platform(byteOrder) eq "littleEndian"} { + set byteOrder 1234 +} else { + set byteOrder 4321 +} +critcl::cflags -DTCL_BYTE_ORDER=$byteOrder + +namespace eval ::sha2 { + # Supporting code for the main command. + catch { + #critcl::debug memory symbols + } + + critcl::ccode { + #include "sha256.h" + #include <stdlib.h> + #include <string.h> + #include <assert.h> + + static + Tcl_ObjType sha256_type; /* fast internal access representation */ + + static void + sha256_free_rep(Tcl_Obj* obj) + { + SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; + free(mp); + } + + static void + sha256_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) + { + SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; + dup->internalRep.otherValuePtr = malloc(sizeof *mp); + memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); + dup->typePtr = &sha256_type; + } + + static void + sha256_string_rep(Tcl_Obj* obj) + { + unsigned char buf[SHA256_HASH_SIZE]; + Tcl_Obj* temp; + char* str; + SHA256_CTX dup = *(SHA256_CTX*) obj->internalRep.otherValuePtr; + + SHA256Final(&dup, buf); + + /* 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 + sha256_from_any(Tcl_Interp* ip, Tcl_Obj* obj) + { + assert(0); + return TCL_ERROR; + } + + static + Tcl_ObjType sha256_type = { + "sha256c", sha256_free_rep, sha256_dup_rep, sha256_string_rep, + sha256_from_any + }; + } + + critcl::ccommand sha256c_init256 {dummy ip objc objv} { + SHA256_CTX* mp; + unsigned char* data; + int size; + Tcl_Obj* obj; + + if (objc > 1) { + Tcl_WrongNumArgs(ip, 1, objv, ""); + return TCL_ERROR; + } + + obj = Tcl_NewObj(); + mp = (SHA256_CTX*) malloc(sizeof *mp); + SHA256Init(mp); + + if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { + obj->typePtr->freeIntRepProc(obj); + } + + obj->internalRep.otherValuePtr = mp; + obj->typePtr = &sha256_type; + + Tcl_InvalidateStringRep(obj); + Tcl_SetObjResult(ip, obj); + return TCL_OK; + } + + critcl::ccommand sha256c_init224 {dummy ip objc objv} { + SHA256_CTX* mp; + unsigned char* data; + int size; + Tcl_Obj* obj; + + if (objc > 1) { + Tcl_WrongNumArgs(ip, 1, objv, ""); + return TCL_ERROR; + } + + obj = Tcl_NewObj(); + mp = (SHA256_CTX*) malloc(sizeof *mp); + SHA224Init(mp); + + if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { + obj->typePtr->freeIntRepProc(obj); + } + + obj->internalRep.otherValuePtr = mp; + obj->typePtr = &sha256_type; + + Tcl_InvalidateStringRep(obj); + Tcl_SetObjResult(ip, obj); + return TCL_OK; + } + + critcl::ccommand sha256c_update {dummy ip objc objv} { + SHA256_CTX* mp; + unsigned char* data; + int size; + Tcl_Obj* obj; + + if (objc != 3) { + Tcl_WrongNumArgs(ip, 1, objv, "data context"); + return TCL_ERROR; + } + + if (objv[2]->typePtr != &sha256_type + && sha256_from_any(ip, objv[2]) != TCL_OK) { + return TCL_ERROR; + } + + obj = objv[2]; + if (Tcl_IsShared(obj)) { + obj = Tcl_DuplicateObj(obj); + } + + Tcl_InvalidateStringRep(obj); + mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; + + data = Tcl_GetByteArrayFromObj(objv[1], &size); + SHA256Update(mp, data, size); + + Tcl_SetObjResult(ip, obj); + return TCL_OK; + } +} |