Index: .fossil-settings/ignore-glob ================================================================== --- .fossil-settings/ignore-glob +++ .fossil-settings/ignore-glob @@ -1,3 +1,5 @@ appfsd appfsd.o appfsd.tcl.h +sha1.o +sha1.tcl.h Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -22,26 +22,30 @@ TCL_CFLAGS = $(shell . $(TCLCONFIG_SH_PATH); echo "$${TCL_INCLUDE_SPEC}") TCL_LIBS = $(shell . $(TCLCONFIG_SH_PATH); echo "$${TCL_LIB_SPEC}") all: appfsd -appfsd: appfsd.o - $(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) -o appfsd appfsd.o $(LIBS) +appfsd: appfsd.o sha1.o + $(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) -o appfsd appfsd.o sha1.o $(LIBS) appfsd.o: appfsd.c appfsd.tcl.h $(CC) $(CPPFLAGS) $(CFLAGS) -o appfsd.o -c appfsd.c -appfsd.tcl.h: appfsd.tcl sha1.tcl - sed '/@@SHA1\.TCL@@/ r sha1.tcl' appfsd.tcl | sed '/@@SHA1\.TCL@@/ d' | sed 's@[\\"]@\\&@g;s@^@ "@;s@$$@\\n"@' > appfsd.tcl.h.new - mv appfsd.tcl.h.new appfsd.tcl.h +sha1.o: sha1.c sha1.tcl.h + $(CC) $(CPPFLAGS) $(CFLAGS) -o sha1.o -c sha1.c + +%.tcl.h: %.tcl + sed 's@[\\"]@\\&@g;s@^@ "@;s@$$@\\n"@' $^ > $@.new + mv $@.new $@ install: appfsd if [ ! -d '$(DESTDIR)$(sbindir)' ]; then mkdir -p '$(DESTDIR)$(sbindir)'; chmod 755 '$(DESTDIR)$(sbindir)'; fi cp appfsd '$(DESTDIR)$(sbindir)/' clean: rm -f appfsd appfsd.o rm -f appfsd.tcl.h + rm -f sha1.o sha1.tcl.h distclean: clean .PHONY: all test clean distclean install Index: appfsd.c ================================================================== --- appfsd.c +++ appfsd.c @@ -12,10 +12,13 @@ #include #include #include #include +/* From sha1.c */ +int Sha1_Init(Tcl_Interp *interp); + #ifndef APPFS_CACHEDIR #define APPFS_CACHEDIR "/var/cache/appfs" #endif #ifdef DEBUG @@ -93,10 +96,21 @@ } tcl_ret = Tcl_Init(interp); if (tcl_ret != TCL_OK) { fprintf(stderr, "Unable to initialize Tcl. Aborting.\n"); + fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp)); + + Tcl_DeleteInterp(interp); + + return(NULL); + } + + tcl_ret = Tcl_Eval(interp, "package ifneeded sha1 1.0 [list load {} sha1]"); + if (tcl_ret != TCL_OK) { + fprintf(stderr, "Unable to initialize Tcl SHA1. Aborting.\n"); + fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp)); Tcl_DeleteInterp(interp); return(NULL); } @@ -1108,10 +1122,12 @@ globalThread.cachedir = cachedir; globalThread.boottime = time(NULL); globalThread.platform = "linux-x86_64"; globalThread.options.writable = 1; + + Tcl_StaticPackage(NULL, "sha1", Sha1_Init, NULL); pthread_ret = pthread_key_create(&interpKey, NULL); if (pthread_ret != 0) { fprintf(stderr, "Unable to create TSD key for Tcl. Aborting.\n"); Index: appfsd.tcl ================================================================== --- appfsd.tcl +++ appfsd.tcl @@ -1,16 +1,10 @@ #! /usr/bin/env tclsh package require http 2.7 package require sqlite3 - -if {[catch { - package require sha1 -}]} { - @@SHA1.TCL@@ - package require sha1 -} +package require sha1 namespace eval ::appfs { variable cachedir "/tmp/appfs-cache" variable ttl 3600 variable nttl 60 Index: sha1.c ================================================================== --- sha1.c +++ sha1.c @@ -1,249 +1,230 @@ -/* This code is public-domain - it is based on libcrypt - * placed in the public domain by Wei Dai and other contributors. - */ -/* http://oauth.googlecode.com/svn/code/c/liboauth/src/sha1.c */ +/* + SHA-1 in C + By Steve Reid + 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 +*/ + +/* #define LITTLE_ENDIAN * This should be #define'd if true. */ +/* #define SHA1HANDSOFF * Copies data before messing with it. */ #include #include #include #include #include #include #include - -#ifdef __BIG_ENDIAN__ -# define SHA_BIG_ENDIAN -#elif defined __LITTLE_ENDIAN__ -#elif defined __BYTE_ORDER -# if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ -# define SHA_BIG_ENDIAN -# endif -#else /* ! defined __LITTLE_ENDIAN__ */ -# include /* machine/endian.h */ -# if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ -# define SHA_BIG_ENDIAN -# endif +#include + +#define SHA1HANDSOFF 1 + +typedef struct { + uint32_t state[5]; + uint32_t count[2]; + uint8_t buffer[64]; +} SHA1_CTX; + +#ifndef __BIG_ENDIAN +#define __BIG_ENDIAN 4321 +#endif +#ifndef __LITTLE_ENDIAN +#define __LITTLE_ENDIAN 1234 +#endif + +#ifndef __BYTE_ORDER +#ifdef WORDS_BIGENDIAN +#define __BYTE_ORDER __BIG_ENDIAN +#else +#define __BYTE_ORDER __LITTLE_ENDIAN +#endif +#endif + +#if __BYTE_ORDER == __BIG_ENDIAN +#ifndef BIG_ENDIAN +#define BIG_ENDIAN 1 +#endif +#undef LITTLE_ENDIAN +#else +#ifndef LITTLE_ENDIAN +#define LITTLE_ENDIAN 1 +#endif +#undef BIG_ENDIAN +#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 */ +#ifdef LITTLE_ENDIAN +#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 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); + + +/* Hash a single 512-bit block. This is the core of the algorithm. */ + +static void SHA1Transform(uint32_t state[5], uint8_t buffer[64]) { + uint32_t a, b, c, d, e; + typedef union { + uint8_t c[64]; + uint32_t l[16]; + } CHAR64LONG16; + CHAR64LONG16* block; +#ifdef SHA1HANDSOFF + uint8_t workspace[sizeof(*block)]; + + block = (CHAR64LONG16*)workspace; + memcpy(block, buffer, sizeof(*block)); +#else + block = (CHAR64LONG16*)buffer; #endif -/* header */ -#define HASH_LENGTH 20 -#define BLOCK_LENGTH 64 - -typedef struct sha1info { - uint32_t buffer[BLOCK_LENGTH / 4]; - uint32_t state[HASH_LENGTH / 4]; - uint32_t byteCount; - uint8_t bufferOffset; - uint8_t keyBuffer[BLOCK_LENGTH]; - uint8_t innerHash[HASH_LENGTH]; -} sha1info; - -/* public API - prototypes - TODO: doxygen*/ - -/** - */ -static void sha1_init(sha1info *s); -/** - */ -static void sha1_writebyte(sha1info *s, uint8_t data); -/** - */ -static void sha1_write(sha1info *s, const char *data, size_t len); -/** - */ -static uint8_t *sha1_result(sha1info *s); -/** - */ -static void sha1_initHmac(sha1info *s, const uint8_t *key, int keyLength); -/** - */ -static uint8_t *sha1_resultHmac(sha1info *s); - -/* code */ -#define SHA1_K0 0x5a827999 -#define SHA1_K20 0x6ed9eba1 -#define SHA1_K40 0x8f1bbcdc -#define SHA1_K60 0xca62c1d6 - -static void sha1_init(sha1info *s) { - s->state[0] = 0x67452301; - s->state[1] = 0xefcdab89; - s->state[2] = 0x98badcfe; - s->state[3] = 0x10325476; - s->state[4] = 0xc3d2e1f0; - s->byteCount = 0; - s->bufferOffset = 0; + /* Copy context->state[] to working vars */ + a = state[0]; + b = state[1]; + c = state[2]; + d = state[3]; + e = state[4]; + + /* 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); + + /* 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 */ +static void SHA1Init(SHA1_CTX* context) { + /* 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] = 0; + context->count[1] = 0; } -static uint32_t sha1_rol32(uint32_t number, uint8_t bits) { - return ((number << bits) | (number >> (32 - bits))); -} -static void sha1_hashBlock(sha1info *s) { - uint8_t i; - uint32_t a, b, c, d, e, t; +/* Run your data through this. */ +static void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned int len) { + unsigned int i, j; - a = s->state[0]; - b = s->state[1]; - c = s->state[2]; - d = s->state[3]; - e = s->state[4]; - for (i = 0; i < 80; i++) { - if (i >= 16) { - t = s->buffer[(i + 13) & 15] ^ s->buffer[(i + 8) & 15] ^ s->buffer[(i + 2) & 15] ^ s->buffer[i & 15]; - s->buffer[i & 15] = sha1_rol32(t, 1); + j = (context->count[0] >> 3) & 63; + if ((context->count[0] += len << 3) < (len << 3)) { + context->count[1]++; + } + + context->count[1] += (len >> 29); + + if ((j + len) > 63) { + memcpy(&context->buffer[j], data, (i = 64-j)); + SHA1Transform(context->state, context->buffer); + for ( ; i + 63 < len; i += 64) { + SHA1Transform(context->state, &data[i]); } - if (i < 20) { - t = (d ^ (b & (c ^ d))) + SHA1_K0; - } else if (i < 40) { - t = (b ^ c ^ d) + SHA1_K20; - } else if (i < 60) { - t = ((b & c) | (d & (b | c))) + SHA1_K40; - } else { - t = (b ^ c ^ d) + SHA1_K60; - } - t += sha1_rol32(a, 5) + e + s->buffer[i & 15]; - e = d; - d = c; - c = sha1_rol32(b, 30); - b = a; - a = t; + j = 0; + } else { + i = 0; } - s->state[0] += a; - s->state[1] += b; - s->state[2] += c; - s->state[3] += d; - s->state[4] += e; -} -static void sha1_addUncounted(sha1info *s, uint8_t data) { - uint8_t * const b = (uint8_t *) s->buffer; -#ifdef SHA_BIG_ENDIAN - b[s->bufferOffset] = data; -#else - b[s->bufferOffset ^ 3] = data; -#endif - s->bufferOffset++; - if (s->bufferOffset == BLOCK_LENGTH) { - sha1_hashBlock(s); - s->bufferOffset = 0; - } + memcpy(&context->buffer[j], &data[i], len - i); } -static void sha1_writebyte(sha1info *s, uint8_t data) { - ++s->byteCount; - sha1_addUncounted(s, data); -} -static void sha1_write(sha1info *s, const char *data, size_t len) { - for (; len--; ) { - sha1_writebyte(s, (uint8_t) *data++); +/* Add padding and return the message digest. */ +static void SHA1Final(unsigned char digest[20], SHA1_CTX* context) { + unsigned long i; + unsigned char finalcount[8]; + + for (i = 0; i < 8; i++) { + finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)] >> ((3-(i & 3)) * 8) ) & 255); /* Endian independent */ + } + + SHA1Update(context, (unsigned char *) "\200", 1); + + while ((context->count[0] & 504) != 448) { + SHA1Update(context, (unsigned char *)"\0", 1); } -} -static void sha1_pad(sha1info *s) { - /* Implement SHA-1 padding (fips180-2 ยง5.1.1) */ - - /* Pad with 0x80 followed by 0x00 until the end of the block */ - sha1_addUncounted(s, 0x80); - while (s->bufferOffset != 56) { - sha1_addUncounted(s, 0x00); + SHA1Update(context, finalcount, 8); /* Should cause a SHA1Transform() */ + for (i = 0; i < 20; i++) { + digest[i] = (unsigned char) ((context->state[i>>2] >> ((3-(i & 3)) * 8) ) & 255); } - /* Append length in the last 8 bytes */ - sha1_addUncounted(s, 0); /* We're only using 32 bit lengths */ - sha1_addUncounted(s, 0); /* But SHA-1 supports 64 bit lengths */ - sha1_addUncounted(s, 0); /* So zero pad the top bits */ - sha1_addUncounted(s, s->byteCount >> 29); /* Shifting to multiply by 8 */ - sha1_addUncounted(s, s->byteCount >> 21); /* as SHA-1 supports bitstreams as well as */ - sha1_addUncounted(s, s->byteCount >> 13); /* byte. */ - sha1_addUncounted(s, s->byteCount >> 5); - sha1_addUncounted(s, s->byteCount << 3); -} - -static uint8_t *sha1_result(sha1info *s) { - int i; - - /* Pad to complete the last block */ - sha1_pad(s); - -#ifndef SHA_BIG_ENDIAN - /* Swap byte order back */ - for (i = 0; i < 5; i++) { - s->state[i]= - (((s->state[i]) << 24) & 0xff000000) - | (((s->state[i]) << 8) & 0x00ff0000) - | (((s->state[i]) >> 8) & 0x0000ff00) - | (((s->state[i]) >> 24) & 0x000000ff); - } -#endif - /* Return pointer to hash (20 characters) */ - return((uint8_t *) s->state); -} - -#define HMAC_IPAD 0x36 -#define HMAC_OPAD 0x5c - -static void sha1_initHmac(sha1info *s, const uint8_t *key, int keyLength) { - uint8_t i; - - memset(s->keyBuffer, 0, BLOCK_LENGTH); - if (keyLength > BLOCK_LENGTH) { - /* Hash long keys */ - sha1_init(s); - for (; keyLength--; ) { - sha1_writebyte(s, *key++); - } - memcpy(s->keyBuffer, sha1_result(s), HASH_LENGTH); - } else { - /* Block length keys are used as is */ - memcpy(s->keyBuffer, key, keyLength); - } - - /* Start inner hash */ - sha1_init(s); - for (i=0; ikeyBuffer[i] ^ HMAC_IPAD); - } - - return; -} - -static uint8_t *sha1_resultHmac(sha1info *s) { - uint8_t i; - - /* Complete inner hash */ - memcpy(s->innerHash, sha1_result(s), HASH_LENGTH); - - /* Calculate outer hash */ - sha1_init(s); - - for (i = 0; i < BLOCK_LENGTH; i++) { - sha1_writebyte(s, s->keyBuffer[i] ^ HMAC_OPAD); - } - for (i = 0; i < HASH_LENGTH; i++) { - sha1_writebyte(s, s->innerHash[i]); - } - - return(sha1_result(s)); + /* Wipe variables */ + i = 0; + + memset(context->buffer, 0, 64); + memset(context->state, 0, 20); + memset(context->count, 0, 8); + memset(&finalcount, 0, 8); +#ifdef SHA1HANDSOFF /* make SHA1Transform overwrite it's own static vars */ + SHA1Transform(context->state, context->buffer); +#endif } static Tcl_Obj* c_sha1__sha1_file(char* file) { - - sha1info sha1; - uint8_t buf[4096]; + SHA1_CTX ctx; + unsigned char digest[20]; + unsigned char buf[4096]; int fd; ssize_t read_ret; Tcl_Obj *ret; fd = open(file, O_RDONLY); if (fd < 0) { return(NULL); } - sha1_init(&sha1); + SHA1Init(&ctx); while (1) { read_ret = read(fd, buf, sizeof(buf)); if (read_ret == 0) { @@ -254,18 +235,18 @@ close(fd); return(NULL); } - sha1_write(&sha1, buf, read_ret); + SHA1Update(&ctx, buf, read_ret); } close(fd); - sha1_result(&sha1); + SHA1Final(digest, &ctx); - ret = Tcl_NewByteArrayObj(sha1_result(&sha1), HASH_LENGTH); + ret = Tcl_NewByteArrayObj(digest, sizeof(digest)); return(ret); } static int tcl_sha1__sha1_file(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { @@ -279,33 +260,33 @@ rv = c_sha1__sha1_file(_file); if (rv == NULL) { return(TCL_ERROR); } - Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv); + Tcl_SetObjResult(ip, rv); return TCL_OK; } static Tcl_Obj* c_sha1__sha1_string(Tcl_Obj* str) { - - sha1info sha1; + SHA1_CTX ctx; + unsigned char digest[20]; unsigned char *buf; int buf_len; Tcl_Obj *ret; - sha1_init(&sha1); + SHA1Init(&ctx); buf = Tcl_GetByteArrayFromObj(str, &buf_len); if (buf == NULL) { return(NULL); } - sha1_write(&sha1, buf, buf_len); + SHA1Update(&ctx, buf, buf_len); - sha1_result(&sha1); + SHA1Final(digest, &ctx); - ret = Tcl_NewByteArrayObj(sha1_result(&sha1), HASH_LENGTH); + ret = Tcl_NewByteArrayObj(digest, sizeof(digest)); return(ret); } static int tcl_sha1__sha1_string(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { @@ -319,11 +300,11 @@ rv = c_sha1__sha1_string(_str); if (rv == NULL) { return(TCL_ERROR); } - Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv); + Tcl_SetObjResult(ip, rv); return TCL_OK; } int Sha1_Init(Tcl_Interp *interp) { #ifdef USE_TCL_STUBS @@ -331,8 +312,11 @@ return TCL_ERROR; } #endif Tcl_CreateObjCommand(interp, "sha1::_sha1_file", tcl_sha1__sha1_file, NULL, NULL); Tcl_CreateObjCommand(interp, "sha1::_sha1_string", tcl_sha1__sha1_string, NULL, NULL); + Tcl_Eval(interp, +#include "sha1.tcl.h" + ); Tcl_PkgProvide(interp, "sha1", "1.0"); return(TCL_OK); } Index: sha1.tcl ================================================================== --- sha1.tcl +++ sha1.tcl @@ -1,607 +1,44 @@ -# sha1.tcl - +#! /usr/bin/env tclsh + +proc sha1::sha1 args { + set outputmode "hex" + + if {[lindex $args 0] == "-hex"} { + set outputmode "hex" + + set args [lrange $args 1 end] + } elseif {[lindex $args 0] == "-bin"} { + set outputmode "binary" + + set args [lrange $args 1 end] + } -# @@ Meta Begin -# Package sha1 2.0.3 -# Meta platform tcl -# Meta rsk::build::date 2011-03-30 -# Meta description Part of the Tclib sha1 module -# Meta require {Tcl 8.2} -# @@ Meta End + if {[llength $args] == 2} { + set mode [lindex $args 0] + } elseif {[llength $args] == 1} { + set mode "-string" + } else { + return -code error "wrong # args: sha1::sha1 ?-bin|-hex? ?-channel channel|-file file|string?" + } -# -# Copyright (C) 2001 Don Libes -# Copyright (C) 2003 Pat Thoyts -# -# 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. -# ------------------------------------------------------------------------- -# -# $Id: sha1.tcl,v 1.22 2009/05/07 00:35:10 patthoyts Exp $ + switch -- $mode { + "-channel" { + return -code error "Not implemented" + } + "-file" { + set output [_sha1_file [lindex $args end]] + } + "-string" { + set output [_sha1_string [lindex $args end]] + } + default { + return -code error "invalid mode: $mode, must be one of -channel or -file (or a plain string)" + } + } -# @mdgen EXCLUDE: sha1c.tcl - -package require Tcl 8.2; # tcl minimum version - -namespace eval ::sha1 { - variable version 2.0.3 - namespace export sha1 hmac SHA1Init SHA1Update SHA1Final - variable uid - if {![info exists uid]} { - set uid 0 - } -} + if {$outputmode == "hex"} { + binary scan $output H* output + } -proc ::sha1::SHA1Init {} { - 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 "" ] - 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} { - 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} {} { - 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 - - # 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 -} - -# ------------------------------------------------------------------------- - -package provide sha1 $::sha1::version - -# ------------------------------------------------------------------------- -# Local Variables: -# mode: tcl -# indent-tabs-mode: nil -# End: + return $output +}