Overview
| Comment: | Merged in internal_sha1 branch since we should use that as the basis going forward |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | tcl-ops |
| Files: | files | file ages | folders |
| SHA1: | 5ffd966f0575277610544b9a7c5d9b603f2c12df |
| User & Date: | rkeene on 2014-11-06 16:20:39 |
| Other Links: | manifest | tags |
Context
|
2014-11-06
| ||
| 17:11 | Work towards gutting AppFSd to rewrite check-in: aca3a93d56 user: rkeene tags: tcl-ops | |
| 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 | |
| 16:19 | Create new branch named "tcl-ops" check-in: a80b5fa283 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 | |
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 [251c8531b4] to [a8794a7145].
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 ................................................................................ 92 95 93 96 return(NULL); 94 97 } 95 98 96 99 tcl_ret = Tcl_Init(interp); 97 100 if (tcl_ret != TCL_OK) { 98 101 fprintf(stderr, "Unable to initialize Tcl. Aborting.\n"); 102 + fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp)); 103 + 104 + Tcl_DeleteInterp(interp); 105 + 106 + return(NULL); 107 + } 108 + 109 + tcl_ret = Tcl_Eval(interp, "package ifneeded sha1 1.0 [list load {} sha1]"); 110 + if (tcl_ret != TCL_OK) { 111 + fprintf(stderr, "Unable to initialize Tcl SHA1. Aborting.\n"); 112 + fprintf(stderr, "Tcl Error is: %s\n", Tcl_GetStringResult(interp)); 99 113 100 114 Tcl_DeleteInterp(interp); 101 115 102 116 return(NULL); 103 117 } 104 118 105 119 tcl_ret = Tcl_Eval(interp, "" ................................................................................ 1152 1166 char dbfilename[1024]; 1153 1167 int pthread_ret, snprintf_ret, sqlite_ret; 1154 1168 1155 1169 globalThread.cachedir = cachedir; 1156 1170 globalThread.boottime = time(NULL); 1157 1171 globalThread.platform = "linux-x86_64"; 1158 1172 globalThread.options.writable = 1; 1173 + 1174 + Tcl_StaticPackage(NULL, "sha1", Sha1_Init, NULL); 1159 1175 1160 1176 pthread_ret = pthread_key_create(&interpKey, NULL); 1161 1177 if (pthread_ret != 0) { 1162 1178 fprintf(stderr, "Unable to create TSD key for Tcl. Aborting.\n"); 1163 1179 1164 1180 return(1); 1165 1181 }
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}} {
Added sha1.c version [a59d293e66].
1 +/* 2 + SHA-1 in C 3 + By Steve Reid <steve@edmweb.com> 4 + 100% Public Domain 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. */ 17 +#include <tcl.h> 18 +#include <sys/types.h> 19 +#include <sys/stat.h> 20 +#include <unistd.h> 21 +#include <stdint.h> 22 +#include <string.h> 23 +#include <fcntl.h> 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; 98 +#endif 99 + 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; 151 +} 152 + 153 + 154 +/* Run your data through this. */ 155 +static void SHA1Update(SHA1_CTX* context, unsigned char* data, unsigned int len) { 156 + unsigned int i, j; 157 + 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]); 170 + } 171 + j = 0; 172 + } else { 173 + i = 0; 174 + } 175 + 176 + memcpy(&context->buffer[j], &data[i], len - i); 177 +} 178 + 179 + 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); 193 + } 194 + 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); 198 + } 199 + 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 210 +} 211 + 212 +static Tcl_Obj* c_sha1__sha1_file(char* file) { 213 + SHA1_CTX ctx; 214 + unsigned char digest[20]; 215 + unsigned char buf[4096]; 216 + int fd; 217 + ssize_t read_ret; 218 + Tcl_Obj *ret; 219 + 220 + fd = open(file, O_RDONLY); 221 + if (fd < 0) { 222 + return(NULL); 223 + } 224 + 225 + SHA1Init(&ctx); 226 + 227 + while (1) { 228 + read_ret = read(fd, buf, sizeof(buf)); 229 + 230 + if (read_ret == 0) { 231 + break; 232 + } 233 + 234 + if (read_ret < 0) { 235 + close(fd); 236 + 237 + return(NULL); 238 + } 239 + 240 + SHA1Update(&ctx, buf, read_ret); 241 + } 242 + 243 + close(fd); 244 + 245 + SHA1Final(digest, &ctx); 246 + 247 + ret = Tcl_NewByteArrayObj(digest, sizeof(digest)); 248 + 249 + return(ret); 250 +} 251 + 252 +static int tcl_sha1__sha1_file(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { 253 + char* _file; 254 + Tcl_Obj* rv; 255 + if (objc != 2) { 256 + Tcl_WrongNumArgs(ip, 1, objv, "file"); 257 + return TCL_ERROR; 258 + } 259 + _file = Tcl_GetString(objv[1]); 260 + 261 + rv = c_sha1__sha1_file(_file); 262 + if (rv == NULL) { 263 + return(TCL_ERROR); 264 + } 265 + Tcl_SetObjResult(ip, rv); 266 + return TCL_OK; 267 +} 268 + 269 +static Tcl_Obj* c_sha1__sha1_string(Tcl_Obj* str) { 270 + SHA1_CTX ctx; 271 + unsigned char digest[20]; 272 + unsigned char *buf; 273 + int buf_len; 274 + Tcl_Obj *ret; 275 + 276 + SHA1Init(&ctx); 277 + 278 + buf = Tcl_GetByteArrayFromObj(str, &buf_len); 279 + if (buf == NULL) { 280 + return(NULL); 281 + } 282 + 283 + SHA1Update(&ctx, buf, buf_len); 284 + 285 + SHA1Final(digest, &ctx); 286 + 287 + ret = Tcl_NewByteArrayObj(digest, sizeof(digest)); 288 + 289 + return(ret); 290 +} 291 + 292 +static int tcl_sha1__sha1_string(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { 293 + Tcl_Obj* _str; 294 + Tcl_Obj* rv; 295 + if (objc != 2) { 296 + Tcl_WrongNumArgs(ip, 1, objv, "str"); 297 + return TCL_ERROR; 298 + } 299 + _str = objv[1]; 300 + 301 + rv = c_sha1__sha1_string(_str); 302 + if (rv == NULL) { 303 + return(TCL_ERROR); 304 + } 305 + Tcl_SetObjResult(ip, rv); 306 + return TCL_OK; 307 +} 308 + 309 +int Sha1_Init(Tcl_Interp *interp) { 310 +#ifdef USE_TCL_STUBS 311 + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == 0L) { 312 + return TCL_ERROR; 313 + } 314 +#endif 315 + Tcl_CreateObjCommand(interp, "sha1::_sha1_file", tcl_sha1__sha1_file, NULL, NULL); 316 + Tcl_CreateObjCommand(interp, "sha1::_sha1_string", tcl_sha1__sha1_string, NULL, NULL); 317 + Tcl_Eval(interp, 318 +#include "sha1.tcl.h" 319 + ); 320 + Tcl_PkgProvide(interp, "sha1", "1.0"); 321 + return(TCL_OK); 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 +}