Check-in [853a9068a7]
Overview
Comment:Updated to use C-based implementation of SHA1
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | internal_sha1
Files: files | file ages | folders
SHA1:853a9068a79a642e48aaf8ad228b1936edd57a9e
User & Date: rkeene on 2014-11-06 02:29:02
Other Links: manifest | tags
Context
2014-11-06
16:20
Merged in internal_sha1 branch since we should use that as the basis going forward check-in: 5ffd966f05 user: rkeene tags: tcl-ops
02:29
Updated to use C-based implementation of SHA1 Closed-Leaf check-in: 853a9068a7 user: rkeene tags: internal_sha1
00:37
Merged in updates from trunk check-in: ee9eb7ed98 user: rkeene tags: internal_sha1
Changes

Modified .fossil-settings/ignore-glob from [5155de6731] to [6f815d9a84].

     1      1   appfsd
     2      2   appfsd.o
     3      3   appfsd.tcl.h
            4  +sha1.o
            5  +sha1.tcl.h

Modified Makefile from [bee1193267] to [a8fe70a2c7].

    20     20   TCLCONFIG_SH_PATH = $(shell echo 'puts [::tcl::pkgconfig get libdir,install]' | tclsh)/tclConfig.sh
    21     21   endif
    22     22   TCL_CFLAGS = $(shell . $(TCLCONFIG_SH_PATH); echo "$${TCL_INCLUDE_SPEC}")
    23     23   TCL_LIBS = $(shell . $(TCLCONFIG_SH_PATH); echo "$${TCL_LIB_SPEC}")
    24     24   
    25     25   all: appfsd
    26     26   
    27         -appfsd: appfsd.o
    28         -	$(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) -o appfsd appfsd.o $(LIBS)
           27  +appfsd: appfsd.o sha1.o
           28  +	$(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) -o appfsd appfsd.o sha1.o $(LIBS)
    29     29   
    30     30   appfsd.o: appfsd.c appfsd.tcl.h
    31     31   	$(CC) $(CPPFLAGS) $(CFLAGS) -o appfsd.o -c appfsd.c
    32     32   
    33         -appfsd.tcl.h: appfsd.tcl sha1.tcl
    34         -	sed '/@@SHA1\.TCL@@/ r sha1.tcl' appfsd.tcl | sed '/@@SHA1\.TCL@@/ d' | sed 's@[\\"]@\\&@g;s@^@   "@;s@$$@\\n"@' > appfsd.tcl.h.new
    35         -	mv appfsd.tcl.h.new appfsd.tcl.h
           33  +sha1.o: sha1.c sha1.tcl.h
           34  +	$(CC) $(CPPFLAGS) $(CFLAGS) -o sha1.o -c sha1.c
           35  +
           36  +%.tcl.h: %.tcl
           37  +	sed 's@[\\"]@\\&@g;s@^@   "@;s@$$@\\n"@' $^ > $@.new
           38  +	mv $@.new $@
    36     39   
    37     40   install: appfsd
    38     41   	if [ ! -d '$(DESTDIR)$(sbindir)' ]; then mkdir -p '$(DESTDIR)$(sbindir)'; chmod 755 '$(DESTDIR)$(sbindir)'; fi
    39     42   	cp appfsd '$(DESTDIR)$(sbindir)/'
    40     43   
    41     44   clean:
    42     45   	rm -f appfsd appfsd.o
    43     46   	rm -f appfsd.tcl.h
           47  +	rm -f sha1.o sha1.tcl.h
    44     48   
    45     49   distclean: clean
    46     50   
    47     51   .PHONY: all test clean distclean install

Modified appfsd.c from [72840611b5] to [f25bb5c801].

    10     10   #include <errno.h>
    11     11   #include <fcntl.h>
    12     12   #include <stdio.h>
    13     13   #include <fuse.h>
    14     14   #include <pwd.h>
    15     15   #include <tcl.h>
    16     16   
           17  +/* From sha1.c */
           18  +int Sha1_Init(Tcl_Interp *interp);
           19  +
    17     20   #ifndef APPFS_CACHEDIR
    18     21   #define APPFS_CACHEDIR "/var/cache/appfs"
    19     22   #endif
    20     23   
    21     24   #ifdef DEBUG
    22     25   #define APPFS_DEBUG(x...) { fprintf(stderr, "[debug] %s:%i:%s: ", __FILE__, __LINE__, __func__); fprintf(stderr, x); fprintf(stderr, "\n"); }
    23     26   #else
................................................................................
    91     94   
    92     95   		return(NULL);
    93     96   	}
    94     97   
    95     98   	tcl_ret = Tcl_Init(interp);
    96     99   	if (tcl_ret != TCL_OK) {
    97    100   		fprintf(stderr, "Unable to initialize Tcl.  Aborting.\n");
          101  +		fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp));
          102  +
          103  +		Tcl_DeleteInterp(interp);
          104  +
          105  +		return(NULL);
          106  +	}
          107  +
          108  +	tcl_ret = Tcl_Eval(interp, "package ifneeded sha1 1.0 [list load {} sha1]");
          109  +	if (tcl_ret != TCL_OK) {
          110  +		fprintf(stderr, "Unable to initialize Tcl SHA1.  Aborting.\n");
          111  +		fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp));
    98    112   
    99    113   		Tcl_DeleteInterp(interp);
   100    114   
   101    115   		return(NULL);
   102    116   	}
   103    117   
   104    118   	tcl_ret = Tcl_Eval(interp, ""
................................................................................
  1106   1120   	char dbfilename[1024];
  1107   1121   	int pthread_ret, snprintf_ret, sqlite_ret;
  1108   1122   
  1109   1123   	globalThread.cachedir = cachedir;
  1110   1124   	globalThread.boottime = time(NULL);
  1111   1125   	globalThread.platform = "linux-x86_64";
  1112   1126   	globalThread.options.writable = 1;
         1127  +
         1128  +	Tcl_StaticPackage(NULL, "sha1", Sha1_Init, NULL);
  1113   1129   
  1114   1130   	pthread_ret = pthread_key_create(&interpKey, NULL);
  1115   1131   	if (pthread_ret != 0) {
  1116   1132   		fprintf(stderr, "Unable to create TSD key for Tcl.  Aborting.\n");
  1117   1133   
  1118   1134   		return(1);
  1119   1135   	}

Modified appfsd.tcl from [86cb2b92c8] to [1a0526f9cf].

     1      1   #! /usr/bin/env tclsh
     2      2   
     3      3   package require http 2.7
     4      4   package require sqlite3
     5         -
     6         -if {[catch {
     7         -	package require sha1
     8         -}]} {
     9         -	@@SHA1.TCL@@
    10         -	package require sha1
    11         -}
            5  +package require sha1
    12      6   
    13      7   namespace eval ::appfs {
    14      8   	variable cachedir "/tmp/appfs-cache"
    15      9   	variable ttl 3600
    16     10   	variable nttl 60
    17     11   
    18     12   	proc _hash_sep {hash {seps 4}} {

Modified sha1.c from [633b35595f] to [a59d293e66].

     1         -/* This code is public-domain - it is based on libcrypt
     2         - * placed in the public domain by Wei Dai and other contributors.
     3         - */
     4         -/* http://oauth.googlecode.com/svn/code/c/liboauth/src/sha1.c */
            1  +/*
            2  +	SHA-1 in C
            3  +	By Steve Reid <steve@edmweb.com>
            4  +	100% Public Domain
     5      5   
            6  +Test Vectors (from FIPS PUB 180-1)
            7  +"abc"
            8  +  A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D
            9  +"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
           10  +  84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1
           11  +A million repetitions of "a"
           12  +  34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F
           13  +*/
           14  +
           15  +/* #define LITTLE_ENDIAN * This should be #define'd if true. */
           16  +/* #define SHA1HANDSOFF * Copies data before messing with it. */
     6     17   #include <tcl.h>
     7     18   #include <sys/types.h>
     8     19   #include <sys/stat.h>
     9     20   #include <unistd.h>
    10     21   #include <stdint.h>
    11     22   #include <string.h>
    12     23   #include <fcntl.h>
    13         -
    14         -#ifdef __BIG_ENDIAN__
    15         -#	define SHA_BIG_ENDIAN
    16         -#elif defined __LITTLE_ENDIAN__
    17         -#elif defined __BYTE_ORDER
    18         -# if __BYTE_ORDER__ ==  __ORDER_BIG_ENDIAN__
    19         -# define SHA_BIG_ENDIAN
    20         -# endif
    21         -#else /* ! defined __LITTLE_ENDIAN__ */
    22         -# include <endian.h> /* machine/endian.h */
    23         -# if __BYTE_ORDER__ ==  __ORDER_BIG_ENDIAN__
    24         -#  define SHA_BIG_ENDIAN
    25         -# endif
           24  +#include <stdio.h>
           25  +
           26  +#define SHA1HANDSOFF 1
           27  +
           28  +typedef struct {
           29  +	uint32_t state[5];
           30  +	uint32_t count[2];
           31  +	uint8_t  buffer[64];
           32  +} SHA1_CTX;
           33  +
           34  +#ifndef __BIG_ENDIAN
           35  +#define __BIG_ENDIAN 4321
           36  +#endif
           37  +#ifndef __LITTLE_ENDIAN
           38  +#define __LITTLE_ENDIAN 1234
           39  +#endif
           40  +
           41  +#ifndef __BYTE_ORDER
           42  +#ifdef WORDS_BIGENDIAN
           43  +#define __BYTE_ORDER __BIG_ENDIAN
           44  +#else
           45  +#define __BYTE_ORDER __LITTLE_ENDIAN
           46  +#endif
           47  +#endif
           48  +
           49  +#if __BYTE_ORDER == __BIG_ENDIAN
           50  +#ifndef BIG_ENDIAN
           51  +#define BIG_ENDIAN 1
           52  +#endif
           53  +#undef LITTLE_ENDIAN
           54  +#else
           55  +#ifndef LITTLE_ENDIAN
           56  +#define LITTLE_ENDIAN 1
           57  +#endif
           58  +#undef BIG_ENDIAN
           59  +#endif
           60  +
           61  +#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits))))
           62  +
           63  +/* blk0() and blk() perform the initial expand. */
           64  +/* I got the idea of expanding during the round function from SSLeay */
           65  +#ifdef LITTLE_ENDIAN
           66  +#define blk0(i) (block->l[i] = (rol(block->l[i],24)&0xFF00FF00) \
           67  +    |(rol(block->l[i],8)&0x00FF00FF))
           68  +#else
           69  +#define blk0(i) block->l[i]
           70  +#endif
           71  +#define blk(i) (block->l[i&15] = rol(block->l[(i+13)&15]^block->l[(i+8)&15] \
           72  +    ^block->l[(i+2)&15]^block->l[i&15],1))
           73  +
           74  +/* (R0+R1), R2, R3, R4 are the different operations used in SHA1 */
           75  +#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk0(i)+0x5A827999+rol(v,5);w=rol(w,30);
           76  +#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk(i)+0x5A827999+rol(v,5);w=rol(w,30);
           77  +#define R2(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0x6ED9EBA1+rol(v,5);w=rol(w,30);
           78  +#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+blk(i)+0x8F1BBCDC+rol(v,5);w=rol(w,30);
           79  +#define R4(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0xCA62C1D6+rol(v,5);w=rol(w,30);
           80  +
           81  +
           82  +/* Hash a single 512-bit block. This is the core of the algorithm. */
           83  +
           84  +static void SHA1Transform(uint32_t state[5], uint8_t buffer[64]) {
           85  +	uint32_t a, b, c, d, e;
           86  +	typedef union {
           87  +		uint8_t  c[64];
           88  +		uint32_t l[16];
           89  +	} CHAR64LONG16;
           90  +	CHAR64LONG16* block;
           91  +#ifdef SHA1HANDSOFF
           92  +	uint8_t workspace[sizeof(*block)];
           93  +
           94  +	block = (CHAR64LONG16*)workspace;
           95  +	memcpy(block, buffer, sizeof(*block));
           96  +#else
           97  +	block = (CHAR64LONG16*)buffer;
    26     98   #endif
    27     99   
    28         -/* header */
    29         -#define HASH_LENGTH 20
    30         -#define BLOCK_LENGTH 64
    31         -
    32         -typedef struct sha1info {
    33         -	uint32_t buffer[BLOCK_LENGTH / 4];
    34         -	uint32_t state[HASH_LENGTH / 4];
    35         -	uint32_t byteCount;
    36         -	uint8_t bufferOffset;
    37         -	uint8_t keyBuffer[BLOCK_LENGTH];
    38         -	uint8_t innerHash[HASH_LENGTH];
    39         -} sha1info;
    40         -
    41         -/* public API - prototypes - TODO: doxygen*/
    42         -
    43         -/**
    44         - */
    45         -static void sha1_init(sha1info *s);
    46         -/**
    47         - */
    48         -static void sha1_writebyte(sha1info *s, uint8_t data);
    49         -/**
    50         - */
    51         -static void sha1_write(sha1info *s, const char *data, size_t len);
    52         -/**
    53         - */
    54         -static uint8_t *sha1_result(sha1info *s);
    55         -/**
    56         - */
    57         -static void sha1_initHmac(sha1info *s, const uint8_t *key, int keyLength);
    58         -/**
    59         - */
    60         -static uint8_t *sha1_resultHmac(sha1info *s);
    61         -
    62         -/* code */
    63         -#define SHA1_K0  0x5a827999
    64         -#define SHA1_K20 0x6ed9eba1
    65         -#define SHA1_K40 0x8f1bbcdc
    66         -#define SHA1_K60 0xca62c1d6
    67         -
    68         -static void sha1_init(sha1info *s) {
    69         -	s->state[0] = 0x67452301;
    70         -	s->state[1] = 0xefcdab89;
    71         -	s->state[2] = 0x98badcfe;
    72         -	s->state[3] = 0x10325476;
    73         -	s->state[4] = 0xc3d2e1f0;
    74         -	s->byteCount = 0;
    75         -	s->bufferOffset = 0;
          100  +	/* Copy context->state[] to working vars */
          101  +	a = state[0];
          102  +	b = state[1];
          103  +	c = state[2];
          104  +	d = state[3];
          105  +	e = state[4];
          106  +
          107  +	/* 4 rounds of 20 operations each. Loop unrolled. */
          108  +	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);
          109  +	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);
          110  +	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);
          111  +	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);
          112  +	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);
          113  +	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);
          114  +	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);
          115  +	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);
          116  +	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);
          117  +	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);
          118  +	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);
          119  +	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);
          120  +	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);
          121  +	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);
          122  +	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);
          123  +	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);
          124  +	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);
          125  +	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);
          126  +	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);
          127  +	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);
          128  +
          129  +	/* Add the working vars back into context.state[] */
          130  +	state[0] += a;
          131  +	state[1] += b;
          132  +	state[2] += c;
          133  +	state[3] += d;
          134  +	state[4] += e;
          135  +
          136  +	/* Wipe variables */
          137  +	a = b = c = d = e = 0;
          138  +}
          139  +
          140  +
          141  +/* SHA1Init - Initialize new context */
          142  +static void SHA1Init(SHA1_CTX* context) {
          143  +	/* SHA1 initialization constants */
          144  +	context->state[0] = 0x67452301;
          145  +	context->state[1] = 0xEFCDAB89;
          146  +	context->state[2] = 0x98BADCFE;
          147  +	context->state[3] = 0x10325476;
          148  +	context->state[4] = 0xC3D2E1F0;
          149  +	context->count[0] = 0;
          150  +	context->count[1] = 0;
    76    151   }
    77    152   
    78         -static uint32_t sha1_rol32(uint32_t number, uint8_t bits) {
    79         -	return ((number << bits) | (number >> (32 - bits)));
    80         -}
    81    153   
    82         -static void sha1_hashBlock(sha1info *s) {
    83         -	uint8_t i;
    84         -	uint32_t a, b, c, d, e, t;
          154  +/* Run your data through this. */
          155  +static void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned int len) {
          156  +	unsigned int i, j;
    85    157   
    86         -	a = s->state[0];
    87         -	b = s->state[1];
    88         -	c = s->state[2];
    89         -	d = s->state[3];
    90         -	e = s->state[4];
    91         -	for (i = 0; i < 80; i++) {
    92         -		if (i >= 16) {
    93         -			t = s->buffer[(i + 13) & 15] ^ s->buffer[(i + 8) & 15] ^ s->buffer[(i + 2) & 15] ^ s->buffer[i & 15];
    94         -			s->buffer[i & 15] = sha1_rol32(t, 1);
          158  +	j = (context->count[0] >> 3) & 63;
          159  +	if ((context->count[0] += len << 3) < (len << 3)) {
          160  +		context->count[1]++;
          161  +	}
          162  +
          163  +	context->count[1] += (len >> 29);
          164  +
          165  +	if ((j + len) > 63) {
          166  +		memcpy(&context->buffer[j], data, (i = 64-j));
          167  +		SHA1Transform(context->state, context->buffer);
          168  +		for ( ; i + 63 < len; i += 64) {
          169  +			SHA1Transform(context->state, &data[i]);
    95    170   		}
    96         -		if (i < 20) {
    97         -			t = (d ^ (b & (c ^ d))) + SHA1_K0;
    98         -		} else if (i < 40) {
    99         -			t = (b ^ c ^ d) + SHA1_K20;
   100         -		} else if (i < 60) {
   101         -			t = ((b & c) | (d & (b | c))) + SHA1_K40;
   102         -		} else {
   103         -			t = (b ^ c ^ d) + SHA1_K60;
   104         -		}
   105         -		t += sha1_rol32(a, 5) + e + s->buffer[i & 15];
   106         -		e = d;
   107         -		d = c;
   108         -		c = sha1_rol32(b, 30);
   109         -		b = a;
   110         -		a = t;
          171  +		j = 0;
          172  +	} else {
          173  +		i = 0;
   111    174   	}
   112         -	s->state[0] += a;
   113         -	s->state[1] += b;
   114         -	s->state[2] += c;
   115         -	s->state[3] += d;
   116         -	s->state[4] += e;
   117         -}
   118    175   
   119         -static void sha1_addUncounted(sha1info *s, uint8_t data) {
   120         -	uint8_t * const b = (uint8_t *) s->buffer;
   121         -#ifdef SHA_BIG_ENDIAN
   122         -	b[s->bufferOffset] = data;
   123         -#else
   124         -	b[s->bufferOffset ^ 3] = data;
   125         -#endif
   126         -	s->bufferOffset++;
   127         -	if (s->bufferOffset == BLOCK_LENGTH) {
   128         -		sha1_hashBlock(s);
   129         -		s->bufferOffset = 0;
   130         -	}
          176  +	memcpy(&context->buffer[j], &data[i], len - i);
   131    177   }
   132    178   
   133         -static void sha1_writebyte(sha1info *s, uint8_t data) {
   134         -	++s->byteCount;
   135         -	sha1_addUncounted(s, data);
   136         -}
   137    179   
   138         -static void sha1_write(sha1info *s, const char *data, size_t len) {
   139         -	for (; len--; ) {
   140         -		sha1_writebyte(s, (uint8_t) *data++);
          180  +/* Add padding and return the message digest. */
          181  +static void SHA1Final(unsigned char digest[20], SHA1_CTX* context) {
          182  +	unsigned long i;
          183  +	unsigned char finalcount[8];
          184  +
          185  +	for (i = 0; i < 8; i++) {
          186  +		finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)] >> ((3-(i & 3)) * 8) ) & 255);  /* Endian independent */
          187  +	}
          188  +
          189  +	SHA1Update(context, (unsigned char *) "\200", 1);
          190  +
          191  +	while ((context->count[0] & 504) != 448) {
          192  +		SHA1Update(context, (unsigned char *)"\0", 1);
   141    193   	}
   142         -}
   143    194   
   144         -static void sha1_pad(sha1info *s) {
   145         -	/* Implement SHA-1 padding (fips180-2 ยง5.1.1) */
   146         -
   147         -	/* Pad with 0x80 followed by 0x00 until the end of the block */
   148         -	sha1_addUncounted(s, 0x80);
   149         -	while (s->bufferOffset != 56) {
   150         -		sha1_addUncounted(s, 0x00);
          195  +	SHA1Update(context, finalcount, 8);  /* Should cause a SHA1Transform() */
          196  +	for (i = 0; i < 20; i++) {
          197  +		digest[i] = (unsigned char) ((context->state[i>>2] >> ((3-(i & 3)) * 8) ) & 255);
   151    198   	}
   152    199   
   153         -	/* Append length in the last 8 bytes */
   154         -	sha1_addUncounted(s, 0); /* We're only using 32 bit lengths */
   155         -	sha1_addUncounted(s, 0); /* But SHA-1 supports 64 bit lengths */
   156         -	sha1_addUncounted(s, 0); /* So zero pad the top bits */
   157         -	sha1_addUncounted(s, s->byteCount >> 29); /* Shifting to multiply by 8 */
   158         -	sha1_addUncounted(s, s->byteCount >> 21); /* as SHA-1 supports bitstreams as well as */
   159         -	sha1_addUncounted(s, s->byteCount >> 13); /* byte. */
   160         -	sha1_addUncounted(s, s->byteCount >> 5);
   161         -	sha1_addUncounted(s, s->byteCount << 3);
   162         -}
   163         -
   164         -static uint8_t *sha1_result(sha1info *s) {
   165         -	int i;
   166         -
   167         -	/* Pad to complete the last block */
   168         -	sha1_pad(s);
   169         -
   170         -#ifndef SHA_BIG_ENDIAN
   171         -	/* Swap byte order back */
   172         -	for (i = 0; i < 5; i++) {
   173         -		s->state[i]=
   174         -			  (((s->state[i]) << 24) & 0xff000000)
   175         -			| (((s->state[i]) <<  8) & 0x00ff0000)
   176         -			| (((s->state[i]) >>  8) & 0x0000ff00)
   177         -			| (((s->state[i]) >> 24) & 0x000000ff);
   178         -	}
   179         -#endif
   180         -	/* Return pointer to hash (20 characters) */
   181         -	return((uint8_t *) s->state);
   182         -}
   183         -
   184         -#define HMAC_IPAD 0x36
   185         -#define HMAC_OPAD 0x5c
   186         -
   187         -static void sha1_initHmac(sha1info *s, const uint8_t *key, int keyLength) {
   188         -	uint8_t i;
   189         -
   190         -	memset(s->keyBuffer, 0, BLOCK_LENGTH);
   191         -	if (keyLength > BLOCK_LENGTH) {
   192         -		/* Hash long keys */
   193         -		sha1_init(s);
   194         -		for (; keyLength--; ) {
   195         -			sha1_writebyte(s, *key++);
   196         -		}
   197         -		memcpy(s->keyBuffer, sha1_result(s), HASH_LENGTH);
   198         -	} else {
   199         -		/* Block length keys are used as is */
   200         -		memcpy(s->keyBuffer, key, keyLength);
   201         -	}
   202         -
   203         -	/* Start inner hash */
   204         -	sha1_init(s);
   205         -	for (i=0; i<BLOCK_LENGTH; i++) {
   206         -		sha1_writebyte(s, s->keyBuffer[i] ^ HMAC_IPAD);
   207         -	}
   208         -
   209         -	return;
   210         -}
   211         -
   212         -static uint8_t *sha1_resultHmac(sha1info *s) {
   213         -	uint8_t i;
   214         -
   215         -	/* Complete inner hash */
   216         -	memcpy(s->innerHash, sha1_result(s), HASH_LENGTH);
   217         -
   218         -	/* Calculate outer hash */
   219         -	sha1_init(s);
   220         -
   221         -	for (i = 0; i < BLOCK_LENGTH; i++) {
   222         -		sha1_writebyte(s, s->keyBuffer[i] ^ HMAC_OPAD);
   223         -	}
   224         -	for (i = 0; i < HASH_LENGTH; i++) {
   225         -		sha1_writebyte(s, s->innerHash[i]);
   226         -	}
   227         -
   228         -	return(sha1_result(s));
          200  +	/* Wipe variables */
          201  +	i = 0;
          202  +
          203  +	memset(context->buffer, 0, 64);
          204  +	memset(context->state, 0, 20);
          205  +	memset(context->count, 0, 8);
          206  +	memset(&finalcount, 0, 8);
          207  +#ifdef SHA1HANDSOFF  /* make SHA1Transform overwrite it's own static vars */
          208  +	SHA1Transform(context->state, context->buffer);
          209  +#endif
   229    210   }
   230    211   
   231    212   static Tcl_Obj* c_sha1__sha1_file(char* file) {
   232         -
   233         -	sha1info sha1;
   234         -	uint8_t buf[4096];
          213  +	SHA1_CTX ctx;
          214  +	unsigned char digest[20];
          215  +	unsigned char buf[4096];
   235    216   	int fd;
   236    217   	ssize_t read_ret;
   237    218   	Tcl_Obj *ret;
   238    219   
   239    220   	fd = open(file, O_RDONLY);
   240    221   	if (fd < 0) {
   241    222   		return(NULL);
   242    223   	}
   243    224   
   244         -	sha1_init(&sha1);
          225  +	SHA1Init(&ctx);
   245    226   
   246    227   	while (1) {
   247    228   		read_ret = read(fd, buf, sizeof(buf));
   248    229   
   249    230   		if (read_ret == 0) {
   250    231   			break;
   251    232   		}
................................................................................
   252    233   
   253    234   		if (read_ret < 0) {
   254    235   			close(fd);
   255    236   
   256    237   			return(NULL);
   257    238   		}
   258    239   
   259         -		sha1_write(&sha1, buf, read_ret);
          240  +		SHA1Update(&ctx, buf, read_ret);
   260    241   	}
   261    242   
   262    243   	close(fd);
   263    244   
   264         -	sha1_result(&sha1);
          245  +	SHA1Final(digest, &ctx);
   265    246   
   266         -	ret = Tcl_NewByteArrayObj(sha1_result(&sha1), HASH_LENGTH);
          247  +	ret = Tcl_NewByteArrayObj(digest, sizeof(digest));
   267    248   
   268    249   	return(ret);
   269    250   }
   270    251   
   271    252   static int tcl_sha1__sha1_file(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) {
   272    253   	char* _file;
   273    254   	Tcl_Obj* rv;
................................................................................
   277    258   	}
   278    259   	_file = Tcl_GetString(objv[1]);
   279    260   
   280    261   	rv = c_sha1__sha1_file(_file);
   281    262   	if (rv == NULL) {
   282    263   		return(TCL_ERROR);
   283    264   	}
   284         -	Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);
          265  +	Tcl_SetObjResult(ip, rv);
   285    266   	return TCL_OK;
   286    267   }
   287    268   
   288    269   static Tcl_Obj* c_sha1__sha1_string(Tcl_Obj* str) {
   289         -
   290         -	sha1info sha1;
          270  +	SHA1_CTX ctx;
          271  +	unsigned char digest[20];
   291    272   	unsigned char *buf;
   292    273   	int buf_len;
   293    274   	Tcl_Obj *ret;
   294    275   
   295         -	sha1_init(&sha1);
          276  +	SHA1Init(&ctx);
   296    277   
   297    278   	buf = Tcl_GetByteArrayFromObj(str, &buf_len);
   298    279   	if (buf == NULL) {
   299    280   		return(NULL);
   300    281   	}
   301    282   
   302         -	sha1_write(&sha1, buf, buf_len);
          283  +	SHA1Update(&ctx, buf, buf_len);
   303    284   
   304         -	sha1_result(&sha1);
          285  +	SHA1Final(digest, &ctx);
   305    286   
   306         -	ret = Tcl_NewByteArrayObj(sha1_result(&sha1), HASH_LENGTH);
          287  +	ret = Tcl_NewByteArrayObj(digest, sizeof(digest));
   307    288   
   308    289   	return(ret);
   309    290   }
   310    291   
   311    292   static int tcl_sha1__sha1_string(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) {
   312    293   	Tcl_Obj* _str;
   313    294   	Tcl_Obj* rv;
................................................................................
   317    298   	}
   318    299   	_str = objv[1];
   319    300   
   320    301   	rv = c_sha1__sha1_string(_str);
   321    302   	if (rv == NULL) {
   322    303   		return(TCL_ERROR);
   323    304   	}
   324         -	Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);
          305  +	Tcl_SetObjResult(ip, rv);
   325    306   	return TCL_OK;
   326    307   }
   327    308   
   328    309   int Sha1_Init(Tcl_Interp *interp) {
   329    310   #ifdef USE_TCL_STUBS
   330    311   	if (Tcl_InitStubs(interp, TCL_VERSION, 0) == 0L) {
   331    312   		return TCL_ERROR;
   332    313   	}
   333    314   #endif
   334    315   	Tcl_CreateObjCommand(interp, "sha1::_sha1_file", tcl_sha1__sha1_file, NULL, NULL);
   335    316   	Tcl_CreateObjCommand(interp, "sha1::_sha1_string", tcl_sha1__sha1_string, NULL, NULL);
          317  +	Tcl_Eval(interp,
          318  +#include "sha1.tcl.h"
          319  +	);
   336    320   	Tcl_PkgProvide(interp, "sha1", "1.0");
   337    321   	return(TCL_OK);
   338    322   }

Modified sha1.tcl from [a8b3b2afbe] to [235aac1913].

     1         -# sha1.tcl - 
            1  +#! /usr/bin/env tclsh
            2  +
            3  +proc sha1::sha1 args {
            4  +	set outputmode "hex"
            5  +
            6  +	if {[lindex $args 0] == "-hex"} {
            7  +		set outputmode "hex"
            8  +
            9  +		set args [lrange $args 1 end]
           10  +	} elseif {[lindex $args 0] == "-bin"} {
           11  +		set outputmode "binary"
           12  +
           13  +		set args [lrange $args 1 end]
           14  +	}
     2     15   
     3         -# @@ Meta Begin
     4         -# Package sha1 2.0.3
     5         -# Meta platform           tcl
     6         -# Meta rsk::build::date   2011-03-30
     7         -# Meta description        Part of the Tclib sha1 module
     8         -# Meta require            {Tcl 8.2}
     9         -# @@ Meta End
           16  +	if {[llength $args] == 2} {
           17  +		set mode [lindex $args 0]
           18  +	} elseif {[llength $args] == 1} {
           19  +		set mode "-string"
           20  +	} else {
           21  +		return -code error "wrong # args: sha1::sha1 ?-bin|-hex? ?-channel channel|-file file|string?"
           22  +	}
    10     23   
    11         -#
    12         -# Copyright (C) 2001 Don Libes <libes@nist.gov>
    13         -# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
    14         -#
    15         -# SHA1 defined by FIPS 180-1, "The SHA1 Message-Digest Algorithm"
    16         -# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
    17         -#
    18         -# This is an implementation of SHA1 based upon the example code given in
    19         -# FIPS 180-1 and upon the tcllib MD4 implementation and taking some ideas
    20         -# and methods from the earlier tcllib sha1 version by Don Libes.
    21         -#
    22         -# This implementation permits incremental updating of the hash and 
    23         -# provides support for external compiled implementations either using
    24         -# critcl (sha1c) or Trf.
    25         -#
    26         -# ref: http://www.itl.nist.gov/fipspubs/fip180-1.htm
    27         -#
    28         -# -------------------------------------------------------------------------
    29         -# See the file "license.terms" for information on usage and redistribution
    30         -# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    31         -# -------------------------------------------------------------------------
    32         -#
    33         -# $Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $
           24  +	switch -- $mode {
           25  +		"-channel" {
           26  +			return -code error "Not implemented"
           27  +		}
           28  +		"-file" {
           29  +			set output [_sha1_file [lindex $args end]]
           30  +		}
           31  +		"-string" {
           32  +			set output [_sha1_string [lindex $args end]]
           33  +		}
           34  +		default {
           35  +			return -code error "invalid mode: $mode, must be one of -channel or -file (or a plain string)"
           36  +		}
           37  +	}
    34     38   
    35         -# @mdgen EXCLUDE: sha1c.tcl
    36         -
    37         -package require Tcl 8.2;                # tcl minimum version
    38         -
    39         -namespace eval ::sha1 {
    40         -    variable  version 2.0.3
    41         -    namespace export sha1 hmac SHA1Init SHA1Update SHA1Final
    42         -    variable uid
    43         -    if {![info exists uid]} {
    44         -        set uid 0
    45         -    }
    46         -}
           39  +	if {$outputmode == "hex"} {
           40  +		binary scan $output H* output
           41  +	}
    47     42   
    48         -proc ::sha1::SHA1Init {} {
    49         -    variable uid
    50         -    set token [namespace current]::[incr uid]
    51         -    upvar #0 $token state
    52         -
    53         -    # FIPS 180-1: 7 - Initialize the hash state
    54         -    array set state \
    55         -        [list \
    56         -             A [expr {int(0x67452301)}] \
    57         -             B [expr {int(0xEFCDAB89)}] \
    58         -             C [expr {int(0x98BADCFE)}] \
    59         -             D [expr {int(0x10325476)}] \
    60         -             E [expr {int(0xC3D2E1F0)}] \
    61         -             n 0 i "" ]
    62         -    return $token
    63         -}
    64         -
    65         -# SHA1Update --
    66         -#
    67         -#   This is called to add more data into the hash. You may call this
    68         -#   as many times as you require. Note that passing in "ABC" is equivalent
    69         -#   to passing these letters in as separate calls -- hence this proc 
    70         -#   permits hashing of chunked data
    71         -#
    72         -#   If we have a C-based implementation available, then we will use
    73         -#   it here in preference to the pure-Tcl implementation.
    74         -#
    75         -proc ::sha1::SHA1Update {token data} {
    76         -    upvar #0 $token state
    77         -
    78         -    # Update the state values
    79         -    incr state(n) [string length $data]
    80         -    append state(i) $data
    81         -
    82         -    # Calculate the hash for any complete blocks
    83         -    set len [string length $state(i)]
    84         -    for {set n 0} {($n + 64) <= $len} {} {
    85         -        SHA1Transform $token [string range $state(i) $n [incr n 64]]
    86         -    }
    87         -
    88         -    # Adjust the state for the blocks completed.
    89         -    set state(i) [string range $state(i) $n end]
    90         -    return
    91         -}
    92         -
    93         -# SHA1Final --
    94         -#
    95         -#    This procedure is used to close the current hash and returns the
    96         -#    hash data. Once this procedure has been called the hash context
    97         -#    is freed and cannot be used again.
    98         -#
    99         -#    Note that the output is 160 bits represented as binary data.
   100         -#
   101         -proc ::sha1::SHA1Final {token} {
   102         -    upvar #0 $token state
   103         -
   104         -    # Padding
   105         -    #
   106         -    set len [string length $state(i)]
   107         -    set pad [expr {56 - ($len % 64)}]
   108         -    if {$len % 64 > 56} {
   109         -        incr pad 64
   110         -    }
   111         -    if {$pad == 0} {
   112         -        incr pad 64
   113         -    }
   114         -    append state(i) [binary format a$pad \x80]
   115         -
   116         -    # Append length in bits as big-endian wide int.
   117         -    set dlen [expr {8 * $state(n)}]
   118         -    append state(i) [binary format II 0 $dlen]
   119         -
   120         -    # Calculate the hash for the remaining block.
   121         -    set len [string length $state(i)]
   122         -    for {set n 0} {($n + 64) <= $len} {} {
   123         -        SHA1Transform $token [string range $state(i) $n [incr n 64]]
   124         -    }
   125         -
   126         -    # Output
   127         -    set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)][bytes $state(E)]
   128         -    unset state
   129         -    return $r
   130         -}
   131         -
   132         -# -------------------------------------------------------------------------
   133         -# HMAC Hashed Message Authentication (RFC 2104)
   134         -#
   135         -# hmac = H(K xor opad, H(K xor ipad, text))
   136         -#
   137         -
   138         -# HMACInit --
   139         -#
   140         -#    This is equivalent to the SHA1Init procedure except that a key is
   141         -#    added into the algorithm
   142         -#
   143         -proc ::sha1::HMACInit {K} {
   144         -
   145         -    # Key K is adjusted to be 64 bytes long. If K is larger, then use
   146         -    # the SHA1 digest of K and pad this instead.
   147         -    set len [string length $K]
   148         -    if {$len > 64} {
   149         -        set tok [SHA1Init]
   150         -        SHA1Update $tok $K
   151         -        set K [SHA1Final $tok]
   152         -        set len [string length $K]
   153         -    }
   154         -    set pad [expr {64 - $len}]
   155         -    append K [string repeat \0 $pad]
   156         -
   157         -    # Cacluate the padding buffers.
   158         -    set Ki {}
   159         -    set Ko {}
   160         -    binary scan $K i16 Ks
   161         -    foreach k $Ks {
   162         -        append Ki [binary format i [expr {$k ^ 0x36363636}]]
   163         -        append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]]
   164         -    }
   165         -
   166         -    set tok [SHA1Init]
   167         -    SHA1Update $tok $Ki;                 # initialize with the inner pad
   168         -    
   169         -    # preserve the Ko value for the final stage.
   170         -    # FRINK: nocheck
   171         -    set [subst $tok](Ko) $Ko
   172         -
   173         -    return $tok
   174         -}
   175         -
   176         -# HMACUpdate --
   177         -#
   178         -#    Identical to calling SHA1Update
   179         -#
   180         -proc ::sha1::HMACUpdate {token data} {
   181         -    SHA1Update $token $data
   182         -    return
   183         -}
   184         -
   185         -# HMACFinal --
   186         -#
   187         -#    This is equivalent to the SHA1Final procedure. The hash context is
   188         -#    closed and the binary representation of the hash result is returned.
   189         -#
   190         -proc ::sha1::HMACFinal {token} {
   191         -    upvar #0 $token state
   192         -
   193         -    set tok [SHA1Init];                 # init the outer hashing function
   194         -    SHA1Update $tok $state(Ko);         # prepare with the outer pad.
   195         -    SHA1Update $tok [SHA1Final $token]; # hash the inner result
   196         -    return [SHA1Final $tok]
   197         -}
   198         -
   199         -# -------------------------------------------------------------------------
   200         -# Description:
   201         -#  This is the core SHA1 algorithm. It is a lot like the MD4 algorithm but
   202         -#  includes an extra round and a set of constant modifiers throughout.
   203         -#
   204         -set ::sha1::SHA1Transform_body {
   205         -    upvar #0 $token state
   206         -
   207         -    # FIPS 180-1: 7a: Process Message in 16-Word Blocks
   208         -    binary scan $msg I* blocks
   209         -    set blockLen [llength $blocks]
   210         -    for {set i 0} {$i < $blockLen} {incr i 16} {
   211         -        set W [lrange $blocks $i [expr {$i+15}]]
   212         -        
   213         -        # FIPS 180-1: 7b: Expand the input into 80 words
   214         -        # For t = 16 to 79 
   215         -        #   let Wt = (Wt-3 ^ Wt-8 ^ Wt-14 ^ Wt-16) <<< 1
   216         -        set t3  12
   217         -        set t8   7
   218         -        set t14  1
   219         -        set t16 -1
   220         -        for {set t 16} {$t < 80} {incr t} {
   221         -            set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \
   222         -                             [lindex $W [incr t14]] ^ [lindex $W [incr t16]]}]
   223         -            lappend W [expr {int(($x << 1) | (($x >> 31) & 1))}]
   224         -        }
   225         -        
   226         -        # FIPS 180-1: 7c: Copy hash state.
   227         -        set A $state(A)
   228         -        set B $state(B)
   229         -        set C $state(C)
   230         -        set D $state(D)
   231         -        set E $state(E)
   232         -
   233         -        # FIPS 180-1: 7d: Do permutation rounds
   234         -        # For t = 0 to 79 do
   235         -        #   TEMP = (A<<<5) + ft(B,C,D) + E + Wt + Kt;
   236         -        #   E = D; D = C; C = S30(B); B = A; A = TEMP;
   237         -
   238         -        # Round 1: ft(B,C,D) = (B & C) | (~B & D) ( 0 <= t <= 19)
   239         -        for {set t 0} {$t < 20} {incr t} {
   240         -            set TEMP [F1 $A $B $C $D $E [lindex $W $t]]
   241         -            set E $D
   242         -            set D $C
   243         -            set C [rotl32 $B 30]
   244         -            set B $A
   245         -            set A $TEMP
   246         -        }
   247         -
   248         -        # Round 2: ft(B,C,D) = (B ^ C ^ D) ( 20 <= t <= 39)
   249         -        for {} {$t < 40} {incr t} {
   250         -            set TEMP [F2 $A $B $C $D $E [lindex $W $t]]
   251         -            set E $D
   252         -            set D $C
   253         -            set C [rotl32 $B 30]
   254         -            set B $A
   255         -            set A $TEMP
   256         -        }
   257         -
   258         -        # Round 3: ft(B,C,D) = ((B & C) | (B & D) | (C & D)) ( 40 <= t <= 59)
   259         -        for {} {$t < 60} {incr t} {
   260         -            set TEMP [F3 $A $B $C $D $E [lindex $W $t]]
   261         -            set E $D
   262         -            set D $C
   263         -            set C [rotl32 $B 30]
   264         -            set B $A
   265         -            set A $TEMP
   266         -         }
   267         -
   268         -        # Round 4: ft(B,C,D) = (B ^ C ^ D) ( 60 <= t <= 79)
   269         -        for {} {$t < 80} {incr t} {
   270         -            set TEMP [F4 $A $B $C $D $E [lindex $W $t]]
   271         -            set E $D
   272         -            set D $C
   273         -            set C [rotl32 $B 30]
   274         -            set B $A
   275         -            set A $TEMP
   276         -        }
   277         -
   278         -        # Then perform the following additions. (That is, increment each
   279         -        # of the four registers by the value it had before this block
   280         -        # was started.)
   281         -        incr state(A) $A
   282         -        incr state(B) $B
   283         -        incr state(C) $C
   284         -        incr state(D) $D
   285         -        incr state(E) $E
   286         -    }
   287         -
   288         -    return
   289         -}
   290         -
   291         -proc ::sha1::F1 {A B C D E W} {
   292         -    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
   293         -               + ($D ^ ($B & ($C ^ $D))) + $E + $W + 0x5a827999) & 0xffffffff}
   294         -}
   295         -
   296         -proc ::sha1::F2 {A B C D E W} {
   297         -    expr {(((($A << 5) & 0xffffffff) | (($A >> 27) & 0x1f)) \
   298         -               + ($B ^ $C ^ $D) + $E + $W + 0x6ed9eba1) & 0xffffffff}
   299         -}
   300         -
   301         -proc ::sha1::F3 {A B C D E W} {
   302         -    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
   303         -               + (($B & $C) | ($D & ($B | $C))) + $E + $W + 0x8f1bbcdc) & 0xffffffff}
   304         -}
   305         -
   306         -proc ::sha1::F4 {A B C D E W} {
   307         -    expr {(((($A << 5) & 0xffffffff)| (($A >> 27) & 0x1f)) \
   308         -               + ($B ^ $C ^ $D) + $E + $W + 0xca62c1d6) & 0xffffffff}
   309         -}
   310         -
   311         -proc ::sha1::rotl32 {v n} {
   312         -    return [expr {((($v << $n) \
   313         -                        | (($v >> (32 - $n)) \
   314         -                               & (0x7FFFFFFF >> (31 - $n))))) \
   315         -                      & 0xFFFFFFFF}]
   316         -}
   317         -
   318         -
   319         -# -------------------------------------------------------------------------
   320         -# 
   321         -# In order to get this code to go as fast as possible while leaving
   322         -# the main code readable we can substitute the above function bodies
   323         -# into the transform procedure. This inlines the code for us an avoids
   324         -# a procedure call overhead within the loops.
   325         -#
   326         -# We can do some minor tweaking to improve speed on Tcl < 8.5 where we
   327         -# know our arithmetic is limited to 64 bits. On > 8.5 we may have 
   328         -# unconstrained integer arithmetic and must avoid letting it run away.
   329         -#
   330         -
   331         -regsub -all -line \
   332         -    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   333         -    $::sha1::SHA1Transform_body \
   334         -    {[expr {(rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999) \& 0xffffffff}]} \
   335         -    ::sha1::SHA1Transform_body_tmp
   336         -
   337         -regsub -all -line \
   338         -    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   339         -    $::sha1::SHA1Transform_body_tmp \
   340         -    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1) \& 0xffffffff}]} \
   341         -    ::sha1::SHA1Transform_body_tmp
   342         -
   343         -regsub -all -line \
   344         -    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   345         -    $::sha1::SHA1Transform_body_tmp \
   346         -    {[expr {(rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc) \& 0xffffffff}]} \
   347         -    ::sha1::SHA1Transform_body_tmp
   348         -
   349         -regsub -all -line \
   350         -    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   351         -    $::sha1::SHA1Transform_body_tmp \
   352         -    {[expr {(rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6) \& 0xffffffff}]} \
   353         -    ::sha1::SHA1Transform_body_tmp
   354         -
   355         -regsub -all -line \
   356         -    {rotl32\(\$A,5\)} \
   357         -    $::sha1::SHA1Transform_body_tmp \
   358         -    {((($A << 5) \& 0xffffffff) | (($A >> 27) \& 0x1f))} \
   359         -    ::sha1::SHA1Transform_body_tmp
   360         -
   361         -regsub -all -line \
   362         -    {\[rotl32 \$B 30\]} \
   363         -    $::sha1::SHA1Transform_body_tmp \
   364         -    {[expr {int(($B << 30) | (($B >> 2) \& 0x3fffffff))}]} \
   365         -    ::sha1::SHA1Transform_body_tmp
   366         -#
   367         -# Version 2 avoids a few truncations to 32 bits in non-essential places.
   368         -#
   369         -regsub -all -line \
   370         -    {\[F1 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   371         -    $::sha1::SHA1Transform_body \
   372         -    {[expr {rotl32($A,5) + ($D ^ ($B \& ($C ^ $D))) + $E + \1 + 0x5a827999}]} \
   373         -    ::sha1::SHA1Transform_body_tmp2
   374         -
   375         -regsub -all -line \
   376         -    {\[F2 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   377         -    $::sha1::SHA1Transform_body_tmp2 \
   378         -    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0x6ed9eba1}]} \
   379         -    ::sha1::SHA1Transform_body_tmp2
   380         -
   381         -regsub -all -line \
   382         -    {\[F3 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   383         -    $::sha1::SHA1Transform_body_tmp2 \
   384         -    {[expr {rotl32($A,5) + (($B \& $C) | ($D \& ($B | $C))) + $E + \1 + 0x8f1bbcdc}]} \
   385         -    ::sha1::SHA1Transform_body_tmp2
   386         -
   387         -regsub -all -line \
   388         -    {\[F4 \$A \$B \$C \$D \$E (\[.*?\])\]} \
   389         -    $::sha1::SHA1Transform_body_tmp2 \
   390         -    {[expr {rotl32($A,5) + ($B ^ $C ^ $D) + $E + \1 + 0xca62c1d6}]} \
   391         -    ::sha1::SHA1Transform_body_tmp2
   392         -
   393         -regsub -all -line \
   394         -    {rotl32\(\$A,5\)} \
   395         -    $::sha1::SHA1Transform_body_tmp2 \
   396         -    {(($A << 5) | (($A >> 27) \& 0x1f))} \
   397         -    ::sha1::SHA1Transform_body_tmp2
   398         -
   399         -regsub -all -line \
   400         -    {\[rotl32 \$B 30\]} \
   401         -    $::sha1::SHA1Transform_body_tmp2 \
   402         -    {[expr {($B << 30) | (($B >> 2) \& 0x3fffffff)}]} \
   403         -    ::sha1::SHA1Transform_body_tmp2
   404         -
   405         -if {[package vsatisfies [package provide Tcl] 8.5]} {
   406         -    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp
   407         -} else {
   408         -    proc ::sha1::SHA1Transform {token msg} $::sha1::SHA1Transform_body_tmp2
   409         -}
   410         -
   411         -unset ::sha1::SHA1Transform_body
   412         -unset ::sha1::SHA1Transform_body_tmp
   413         -unset ::sha1::SHA1Transform_body_tmp2
   414         -
   415         -# -------------------------------------------------------------------------
   416         -
   417         -proc ::sha1::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}}
   418         -proc ::sha1::bytes {v} { 
   419         -    #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v]
   420         -    format %c%c%c%c \
   421         -        [expr {((0xFF000000 & $v) >> 24) & 0xFF}] \
   422         -        [expr {(0xFF0000 & $v) >> 16}] \
   423         -        [expr {(0xFF00 & $v) >> 8}] \
   424         -        [expr {0xFF & $v}]
   425         -}
   426         -
   427         -# -------------------------------------------------------------------------
   428         -
   429         -proc ::sha1::Hex {data} {
   430         -    binary scan $data H* result
   431         -    return $result
   432         -}
   433         -
   434         -# -------------------------------------------------------------------------
   435         -
   436         -# Description:
   437         -#  Pop the nth element off a list. Used in options processing.
   438         -#
   439         -proc ::sha1::Pop {varname {nth 0}} {
   440         -    upvar $varname args
   441         -    set r [lindex $args $nth]
   442         -    set args [lreplace $args $nth $nth]
   443         -    return $r
   444         -}
   445         -
   446         -# -------------------------------------------------------------------------
   447         -
   448         -# fileevent handler for chunked file hashing.
   449         -#
   450         -proc ::sha1::Chunk {token channel {chunksize 4096}} {
   451         -    upvar #0 $token state
   452         -    
   453         -    if {[eof $channel]} {
   454         -        fileevent $channel readable {}
   455         -        set state(reading) 0
   456         -    }
   457         -        
   458         -    SHA1Update $token [read $channel $chunksize]
   459         -}
   460         -
   461         -# -------------------------------------------------------------------------
   462         -
   463         -proc ::sha1::sha1 {args} {
   464         -    array set opts {-hex 0 -filename {} -channel {} -chunksize 4096}
   465         -    if {[llength $args] == 1} {
   466         -        set opts(-hex) 1
   467         -    } else {
   468         -        while {[string match -* [set option [lindex $args 0]]]} {
   469         -            switch -glob -- $option {
   470         -                -hex       { set opts(-hex) 1 }
   471         -                -bin       { set opts(-hex) 0 }
   472         -                -file*     { set opts(-filename) [Pop args 1] }
   473         -                -channel   { set opts(-channel) [Pop args 1] }
   474         -                -chunksize { set opts(-chunksize) [Pop args 1] }
   475         -                default {
   476         -                    if {[llength $args] == 1} { break }
   477         -                    if {[string compare $option "--"] == 0} { Pop args; break }
   478         -                    set err [join [lsort [concat -bin [array names opts]]] ", "]
   479         -                    return -code error "bad option $option:\
   480         -                    must be one of $err"
   481         -                }
   482         -            }
   483         -            Pop args
   484         -        }
   485         -    }
   486         -
   487         -    if {$opts(-filename) != {}} {
   488         -        set opts(-channel) [open $opts(-filename) r]
   489         -        fconfigure $opts(-channel) -translation binary
   490         -    }
   491         -
   492         -    if {$opts(-channel) == {}} {
   493         -
   494         -        if {[llength $args] != 1} {
   495         -            return -code error "wrong # args:\
   496         -                should be \"sha1 ?-hex? -filename file | string\""
   497         -        }
   498         -        set tok [SHA1Init]
   499         -        SHA1Update $tok [lindex $args 0]
   500         -        set r [SHA1Final $tok]
   501         -
   502         -    } else {
   503         -
   504         -        set tok [SHA1Init]
   505         -        # FRINK: nocheck
   506         -        set [subst $tok](reading) 1
   507         -        fileevent $opts(-channel) readable \
   508         -            [list [namespace origin Chunk] \
   509         -                 $tok $opts(-channel) $opts(-chunksize)]
   510         -        # FRINK: nocheck
   511         -        vwait [subst $tok](reading)
   512         -        set r [SHA1Final $tok]
   513         -
   514         -        # If we opened the channel - we should close it too.
   515         -        if {$opts(-filename) != {}} {
   516         -            close $opts(-channel)
   517         -        }
   518         -    }
   519         -    
   520         -    if {$opts(-hex)} {
   521         -        set r [Hex $r]
   522         -    }
   523         -    return $r
   524         -}
   525         -
   526         -# -------------------------------------------------------------------------
   527         -
   528         -proc ::sha1::hmac {args} {
   529         -    array set opts {-hex 1 -filename {} -channel {} -chunksize 4096}
   530         -    if {[llength $args] != 2} {
   531         -        while {[string match -* [set option [lindex $args 0]]]} {
   532         -            switch -glob -- $option {
   533         -                -key       { set opts(-key) [Pop args 1] }
   534         -                -hex       { set opts(-hex) 1 }
   535         -                -bin       { set opts(-hex) 0 }
   536         -                -file*     { set opts(-filename) [Pop args 1] }
   537         -                -channel   { set opts(-channel) [Pop args 1] }
   538         -                -chunksize { set opts(-chunksize) [Pop args 1] }
   539         -                default {
   540         -                    if {[llength $args] == 1} { break }
   541         -                    if {[string compare $option "--"] == 0} { Pop args; break }
   542         -                    set err [join [lsort [array names opts]] ", "]
   543         -                    return -code error "bad option $option:\
   544         -                    must be one of $err"
   545         -                }
   546         -            }
   547         -            Pop args
   548         -        }
   549         -    }
   550         -
   551         -    if {[llength $args] == 2} {
   552         -        set opts(-key) [Pop args]
   553         -    }
   554         -
   555         -    if {![info exists opts(-key)]} {
   556         -        return -code error "wrong # args:\
   557         -            should be \"hmac ?-hex? -key key -filename file | string\""
   558         -    }
   559         -
   560         -    if {$opts(-filename) != {}} {
   561         -        set opts(-channel) [open $opts(-filename) r]
   562         -        fconfigure $opts(-channel) -translation binary
   563         -    }
   564         -
   565         -    if {$opts(-channel) == {}} {
   566         -
   567         -        if {[llength $args] != 1} {
   568         -            return -code error "wrong # args:\
   569         -                should be \"hmac ?-hex? -key key -filename file | string\""
   570         -        }
   571         -        set tok [HMACInit $opts(-key)]
   572         -        HMACUpdate $tok [lindex $args 0]
   573         -        set r [HMACFinal $tok]
   574         -
   575         -    } else {
   576         -
   577         -        set tok [HMACInit $opts(-key)]
   578         -        # FRINK: nocheck
   579         -        set [subst $tok](reading) 1
   580         -        fileevent $opts(-channel) readable \
   581         -            [list [namespace origin Chunk] \
   582         -                 $tok $opts(-channel) $opts(-chunksize)]
   583         -        # FRINK: nocheck
   584         -        vwait [subst $tok](reading)
   585         -        set r [HMACFinal $tok]
   586         -
   587         -        # If we opened the channel - we should close it too.
   588         -        if {$opts(-filename) != {}} {
   589         -            close $opts(-channel)
   590         -        }
   591         -    }
   592         -    
   593         -    if {$opts(-hex)} {
   594         -        set r [Hex $r]
   595         -    }
   596         -    return $r
   597         -}
   598         -
   599         -# -------------------------------------------------------------------------
   600         -
   601         -package provide sha1 $::sha1::version
   602         -
   603         -# -------------------------------------------------------------------------
   604         -# Local Variables:
   605         -#   mode: tcl
   606         -#   indent-tabs-mode: nil
   607         -# End:
           43  +	return $output
           44  +}