pax_global_header00006660000000000000000000000064122244315100014504gustar00rootroot0000000000000052 comment=73f9b8499a7186a435f111bf91e0abcff4e862d4 ocaml-sha-ocaml-sha-v1.9/000077500000000000000000000000001222443151000152515ustar00rootroot00000000000000ocaml-sha-ocaml-sha-v1.9/.gitignore000066400000000000000000000000541222443151000172400ustar00rootroot00000000000000*.a *.o *.so *.cmi *.cmx *.cmxa *.cmo *.cma ocaml-sha-ocaml-sha-v1.9/META000066400000000000000000000010141222443151000157160ustar00rootroot00000000000000description="SHA-1 and SHA-2 family implementations" version="1.9" archive(byte)="sha.cma" archive(native)="sha.cmxa" package "sha1" ( description="SHA-1 Implementation" version="1.9" archive(byte)="sha1.cma" archive(native)="sha1.cmxa" ) package "sha256" ( description="SHA-256 Implementation" version="1.9" archive(byte)="sha256.cma" archive(native)="sha256.cmxa" ) package "sha512" ( description="SHA-512 Implementation" version="1.9" archive(byte)="sha512.cma" archive(native)="sha512.cmxa" ) ocaml-sha-ocaml-sha-v1.9/Makefile000066400000000000000000000061271222443151000167170ustar00rootroot00000000000000CFLAGS = -Wall -O3 -funroll-loops -I/usr/include OCAMLC = ocamlc OCAMLOPT = ocamlopt OCAMLMKLIB = ocamlmklib # on unix architecture we just use the default value EXE= OBJ=o A=a SO=so # on windows architecture redefine some values ifeq "$(shell ocamlc -config | fgrep 'os_type:')" "os_type: Win32" EXE=.exe SO=dll ifeq "$(shell ocamlc -config | fgrep 'ccomp_type:')" "ccomp_type: msvc" OBJ=obj A=lib endif endif OCAMLOPTFLAGS = OCAML_TEST_INC = -I `ocamlfind query oUnit` OCAML_TEST_LIB = `ocamlfind query oUnit`/oUnit.cmxa PROGRAMS_BINS = sha1sum sha256sum sha512sum PROGRAMS = $(addsuffix $(EXE), $(PROGRAMS_BINS)) allshabytes = $(foreach n, 1 256 512, sha$(n).lib.$(OBJ) sha$(n)_stubs.$(OBJ) sha$(n).cmo) allshaopts = $(foreach n, 1 256 512, sha$(n).lib.$(OBJ) sha$(n)_stubs.$(OBJ) sha$(n).cmx) all: sha1.cmi sha1.cma sha1.cmxa sha256.cma sha256.cmxa sha512.cma sha512.cmxa sha.cma sha.cmxa bins: $(PROGRAMS) sha1sum$(EXE): sha1.cmxa sha256.cmxa sha512.cmxa shasum.cmx $(OCAMLOPT) $(OCAMLOPTFLAGS) -o $@ -cclib -L. $+ sha256sum$(EXE): sha1sum$(EXE) cp $< $@ sha512sum$(EXE): sha1sum$(EXE) cp $< $@ sha.cma: $(allshabytes) $(OCAMLMKLIB) -o sha $(allshabytes) sha.cmxa: $(allshaopts) $(OCAMLMKLIB) -o sha $(allshaopts) sha1.cma: sha1.cmi sha1.lib.$(OBJ) sha1_stubs.$(OBJ) sha1.cmo $(OCAMLMKLIB) -o sha1 sha1.lib.$(OBJ) sha1_stubs.$(OBJ) sha1.cmo sha1.cmxa: sha1.cmi sha1.lib.$(OBJ) sha1_stubs.$(OBJ) sha1.cmx $(OCAMLMKLIB) -o sha1 sha1.lib.$(OBJ) sha1_stubs.$(OBJ) sha1.cmx sha256.cma: sha256.cmi sha256.lib.$(OBJ) sha256_stubs.$(OBJ) sha256.cmo $(OCAMLMKLIB) -o sha256 sha256.lib.$(OBJ) sha256_stubs.$(OBJ) sha256.cmo sha256.cmxa: sha256.cmi sha256.lib.$(OBJ) sha256_stubs.$(OBJ) sha256.cmx $(OCAMLMKLIB) -o sha256 sha256.lib.$(OBJ) sha256_stubs.$(OBJ) sha256.cmx sha512.cma: sha512.cmi sha512.lib.$(OBJ) sha512_stubs.$(OBJ) sha512.cmo $(OCAMLMKLIB) -o sha512 sha512.lib.$(OBJ) sha512_stubs.$(OBJ) sha512.cmo sha512.cmxa: sha512.cmi sha512.lib.$(OBJ) sha512_stubs.$(OBJ) sha512.cmx $(OCAMLMKLIB) -o sha512 sha512.lib.$(OBJ) sha512_stubs.$(OBJ) sha512.cmx tests: sha.test ./sha.test sha.test: sha1.cmxa sha256.cmxa sha512.cmxa sha.test.cmx %.test: $(OCAMLOPT) -o $@ $(OCAML_BFLAGS) unix.cmxa $(OCAML_TEST_INC) $(OCAML_TEST_LIB) $+ %.test.cmo: %.test.ml $(OCAMLC) -c -o $@ $(OCAML_BFLAGS) -custom $(OCAML_TEST_INC) $< %.test.cmx: %.test.ml $(OCAMLOPT) -c -o $@ $(OCAML_BFLAGS) $(OCAML_TEST_INC) $< %.cmo: %.ml $(OCAMLC) -c -o $@ $< %.cmi: %.mli $(OCAMLC) -c -o $@ $< %.cmx: %.ml $(OCAMLOPT) $(OCAMLOPTFLAGS) -c -o $@ $< %.$(OBJ): %.c $(OCAMLC) -ccopt "$(CFLAGS)" -c -o $@ $< %.lib.$(OBJ): %.$(OBJ) mv $< $@ .PHONY: clean install uninstall doc doc: [ -d html ] && rm -f html/* || mkdir html ocamldoc -html -d html *.mli clean: rm -f *.$(OBJ) *.$(A) *.$(SO) *.cmo *.cmi *.cma *.cmx *.cmxa sha.test $(PROGRAMS) install: sha1.cma sha1.cmxa sha256.cma sha256.cmxa sha512.cma sha512.cmxa sha.cma sha.cmxa META ocamlfind install sha META *.cmx sha1.cmi sha1.cma sha1.cmxa sha256.cmi sha256.cma sha256.cmxa sha512.cmi sha512.cma sha512.cmxa sha.cma sha.cmxa *.$(A) *.$(SO) uninstall: ocamlfind remove sha ocaml-sha-ocaml-sha-v1.9/README000066400000000000000000000005171222443151000161340ustar00rootroot00000000000000General Information =================== This is the binding for SHA interface code in OCaml. Offering the same interface than the MD5 digest included in ocaml standard library. It's currently providing SHA1, SHA256 and SHA512 hash functions. Documentation ============= the documentation can be found in mli files in ocamldoc format. ocaml-sha-ocaml-sha-v1.9/bitfn.h000066400000000000000000000043261222443151000165310ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA implementation low level operation */ #ifndef BITFN_H #define BITFN_H #include static inline unsigned int rol32(unsigned int word, unsigned int shift) { return (word << shift) | (word >> (32 - shift)); } static inline unsigned int ror32(unsigned int word, unsigned int shift) { return (word >> shift) | (word << (32 - shift)); } static inline uint64_t rol64(uint64_t word, unsigned int shift) { return (word << shift) | (word >> (64 - shift)); } static inline uint64_t ror64(uint64_t word, unsigned int shift) { return (word >> shift) | (word << (64 - shift)); } #if (defined(__i386__) || defined(__x86_64__)) && !defined(NO_INLINE_ASM) static inline unsigned int swap32(unsigned int a) { asm ("bswap %0" : "=r" (a) : "0" (a)); return a; } #else static inline unsigned int swap32(unsigned int a) { return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24); } #endif #if defined(__x86_64__) && !defined(NO_INLINE_ASM) static inline uint64_t swap64(uint64_t a) { asm ("bswap %0" : "=r" (a) : "0" (a)); return a; } #else static inline uint64_t swap64(uint64_t a) { return ((uint64_t) swap32((unsigned int) (a >> 32))) | (((uint64_t) swap32((unsigned int) a)) << 32); } #endif /* big endian to cpu */ #ifdef __APPLE__ #include #else #include #endif #if LITTLE_ENDIAN == BYTE_ORDER #define be32_to_cpu(a) swap32(a) #define cpu_to_be32(a) swap32(a) #define be64_to_cpu(a) swap64(a) #define cpu_to_be64(a) swap64(a) #elif BIG_ENDIAN == BYTE_ORDER #define be32_to_cpu(a) (a) #define cpu_to_be32(a) (a) #define be64_to_cpu(a) (a) #define cpu_to_be64(a) (a) #else #error "endian not supported" #endif #endif /* !BITFN_H */ ocaml-sha-ocaml-sha-v1.9/sha.test.ml000066400000000000000000000101261222443151000173340ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1 & SHA256 OCaml binding test unit *) open OUnit let ex_strings_sha1 = [ ("", "da39a3ee5e6b4b0d3255bfef95601890afd80709"); ("The quick brown fox jumps over the lazy cog", "de9f2c7fd25e1b3afad3e85a0bd17d9b100db4b3"); ("The quick brown fox jumps over the lazy dog", "2fd4e1c67a2d28fced849ee1bb76e7391b93eb12"); ] let ex_strings_sha256 = [ ("", "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"); ("The quick brown fox jumps over the lazy cog", "e4c4d8f3bf76b692de791a173e05321150f7a345b46484fe427f6acc7ecc81be"); ("The quick brown fox jumps over the lazy dog", "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592"); ] let ex_strings_sha512 = [ ("", "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"); ("The quick brown fox jumps over the lazy cog", "3eeee1d0e11733ef152a6c29503b3ae20c4f1f3cda4cb26f1bc1a41f91c7fe4ab3bd86494049e201c4bd5155f31ecb7a3c8606843c4cc8dfcab7da11c8ae5045"); ("The quick brown fox jumps over the lazy dog", "07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"); ] let ex_files_sha1 = [ ("README", "ebd97ba45cd1668d242d98522dc0004bb70df4a8") ] let ex_files_sha256 = [ ("README", "7f8213da9acc755d57f3650827176dcdf2f101ea486d5fa357e705d728480878") ] let ex_files_sha512 = [ ("README", "da82cac10002a838aceedc7910b76735ec87b2dce08755680910b8ff287c0f48a1910989f8e3a94f9cb5a391e66d811d190bc3568135514229051c06c6e93f6e") ] let ex_channels_sha1 = [ ("sha.test.ml", "e13052afa4916d56994378f847f157596f9638a2") ] let ex_channels_sha256 = [ ("sha.test.ml", "51598a80bbec8fdcb32c3d180c3e806bf09eb0f5b5bb6f51031a78f46c83caef") ] let ex_channels_sha512 = [ ("sha.test.ml", "2f8e603774643ce152620e1dd94601393e78d33a3e6f67b86df2ef87eb4ad0cde72b481208eaa0249bbcf64072f2fb03b06abd006c5213c7546936ae9e9a1dc1") ] let stringfct_sha1 s = Sha1.to_hex (Sha1.string s) let stringfct_sha256 s = Sha256.to_hex (Sha256.string s) let stringfct_sha512 s = Sha512.to_hex (Sha512.string s) let filefct_sha1 s = Sha1.to_hex (Sha1.file s) let filefct_sha256 s = Sha256.to_hex (Sha256.file s) let filefct_sha512 s = Sha512.to_hex (Sha512.file s) let channelfct_sha1 s i = Sha1.to_hex (Sha1.channel s i) let channelfct_sha256 s i = Sha256.to_hex (Sha256.channel s i) let channelfct_sha512 s i = Sha512.to_hex (Sha512.channel s i) let test_strings stringfct arr _ = List.iter (fun (s,r) -> assert_equal r (stringfct s)) arr let test_file filefct arr _ = List.iter (fun (f,r) -> assert_equal r (filefct f)) arr let test_channel channelfct arr _ = List.iter (fun (c,r) -> let chan = open_in_bin c in let digest = channelfct chan 20 in close_in chan; assert_equal r digest) arr let suite = "SHA binding test" >::: [ "SHA1 example strings" >:: test_strings stringfct_sha1 ex_strings_sha1; "SHA1 reading a file" >:: test_file filefct_sha1 ex_files_sha1; "SHA1 reading few byte from channel" >:: test_channel channelfct_sha1 ex_channels_sha1; "SHA256 example strings" >:: test_strings stringfct_sha256 ex_strings_sha256; "SHA256 reading a file" >:: test_file filefct_sha256 ex_files_sha256; "SHA256 reading few byte from channel" >:: test_channel channelfct_sha256 ex_channels_sha256; "SHA512 example strings" >:: test_strings stringfct_sha512 ex_strings_sha512; "SHA512 reading a file" >:: test_file filefct_sha512 ex_files_sha512; "SHA512 reading few byte from channel" >:: test_channel channelfct_sha512 ex_channels_sha512; ] let _ = run_test_tt ~verbose:true suite ocaml-sha-ocaml-sha-v1.9/sha1.c000066400000000000000000000172421222443151000162570ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1 implementation as describe in wikipedia. */ #include #include #include "sha1.h" #include "bitfn.h" /** * sha1_init - Init SHA1 context */ void sha1_init(struct sha1_ctx *ctx) { memset(ctx, 0, sizeof(*ctx)); /* initialize H */ ctx->h[0] = 0x67452301; ctx->h[1] = 0xEFCDAB89; ctx->h[2] = 0x98BADCFE; ctx->h[3] = 0x10325476; ctx->h[4] = 0xC3D2E1F0; } /** * sha1_copy - Copy SHA1 context */ void sha1_copy(struct sha1_ctx *dst, struct sha1_ctx *src) { memcpy(dst, src, sizeof(*dst)); } #define f1(x, y, z) (z ^ (x & (y ^ z))) /* x ? y : z */ #define f2(x, y, z) (x ^ y ^ z) /* XOR */ #define f3(x, y, z) ((x & y) + (z & (x ^ y))) /* majority */ #define f4(x, y, z) f2(x, y, z) #define K1 0x5A827999L /* Rounds 0-19: sqrt(2) * 2^30 */ #define K2 0x6ED9EBA1L /* Rounds 20-39: sqrt(3) * 2^30 */ #define K3 0x8F1BBCDCL /* Rounds 40-59: sqrt(5) * 2^30 */ #define K4 0xCA62C1D6L /* Rounds 60-79: sqrt(10) * 2^30 */ #define R(a, b, c, d, e, f, k, w) e += rol32(a, 5) + f(b, c, d) + k + w; \ b = rol32(b, 30) #define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \ ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1)) static inline void sha1_do_chunk(unsigned char W[], unsigned int h[]) { unsigned int a, b, c, d, e; unsigned int w[80]; #define CPY(i) w[i] = be32_to_cpu(((unsigned int *) W)[i]) CPY(0); CPY(1); CPY(2); CPY(3); CPY(4); CPY(5); CPY(6); CPY(7); CPY(8); CPY(9); CPY(10); CPY(11); CPY(12); CPY(13); CPY(14); CPY(15); #undef CPY a = h[0]; b = h[1]; c = h[2]; d = h[3]; e = h[4]; /* following unrolled from: * for (i = 0; i < 20; i++) { * t = f1(b, c, d) + K1 + rol32(a, 5) + e + M(i); * e = d; d = c; c = rol32(b, 30); b = a; a = t; * } */ R(a, b, c, d, e, f1, K1, w[0]); R(e, a, b, c, d, f1, K1, w[1]); R(d, e, a, b, c, f1, K1, w[2]); R(c, d, e, a, b, f1, K1, w[3]); R(b, c, d, e, a, f1, K1, w[4]); R(a, b, c, d, e, f1, K1, w[5]); R(e, a, b, c, d, f1, K1, w[6]); R(d, e, a, b, c, f1, K1, w[7]); R(c, d, e, a, b, f1, K1, w[8]); R(b, c, d, e, a, f1, K1, w[9]); R(a, b, c, d, e, f1, K1, w[10]); R(e, a, b, c, d, f1, K1, w[11]); R(d, e, a, b, c, f1, K1, w[12]); R(c, d, e, a, b, f1, K1, w[13]); R(b, c, d, e, a, f1, K1, w[14]); R(a, b, c, d, e, f1, K1, w[15]); R(e, a, b, c, d, f1, K1, M(16)); R(d, e, a, b, c, f1, K1, M(17)); R(c, d, e, a, b, f1, K1, M(18)); R(b, c, d, e, a, f1, K1, M(19)); /* following unrolled from: * for (i = 20; i < 40; i++) { * t = f2(b, c, d) + K2 + rol32(a, 5) + e + M(i); * e = d; d = c; c = rol32(b, 30); b = a; a = t; * } */ R(a, b, c, d, e, f2, K2, M(20)); R(e, a, b, c, d, f2, K2, M(21)); R(d, e, a, b, c, f2, K2, M(22)); R(c, d, e, a, b, f2, K2, M(23)); R(b, c, d, e, a, f2, K2, M(24)); R(a, b, c, d, e, f2, K2, M(25)); R(e, a, b, c, d, f2, K2, M(26)); R(d, e, a, b, c, f2, K2, M(27)); R(c, d, e, a, b, f2, K2, M(28)); R(b, c, d, e, a, f2, K2, M(29)); R(a, b, c, d, e, f2, K2, M(30)); R(e, a, b, c, d, f2, K2, M(31)); R(d, e, a, b, c, f2, K2, M(32)); R(c, d, e, a, b, f2, K2, M(33)); R(b, c, d, e, a, f2, K2, M(34)); R(a, b, c, d, e, f2, K2, M(35)); R(e, a, b, c, d, f2, K2, M(36)); R(d, e, a, b, c, f2, K2, M(37)); R(c, d, e, a, b, f2, K2, M(38)); R(b, c, d, e, a, f2, K2, M(39)); /* following unrolled from: * for (i = 40; i < 60; i++) { * t = f3(b, c, d) + K3 + rol32(a, 5) + e + M(i); * e = d; d = c; c = rol32(b, 30); b = a; a = t; * } */ R(a, b, c, d, e, f3, K3, M(40)); R(e, a, b, c, d, f3, K3, M(41)); R(d, e, a, b, c, f3, K3, M(42)); R(c, d, e, a, b, f3, K3, M(43)); R(b, c, d, e, a, f3, K3, M(44)); R(a, b, c, d, e, f3, K3, M(45)); R(e, a, b, c, d, f3, K3, M(46)); R(d, e, a, b, c, f3, K3, M(47)); R(c, d, e, a, b, f3, K3, M(48)); R(b, c, d, e, a, f3, K3, M(49)); R(a, b, c, d, e, f3, K3, M(50)); R(e, a, b, c, d, f3, K3, M(51)); R(d, e, a, b, c, f3, K3, M(52)); R(c, d, e, a, b, f3, K3, M(53)); R(b, c, d, e, a, f3, K3, M(54)); R(a, b, c, d, e, f3, K3, M(55)); R(e, a, b, c, d, f3, K3, M(56)); R(d, e, a, b, c, f3, K3, M(57)); R(c, d, e, a, b, f3, K3, M(58)); R(b, c, d, e, a, f3, K3, M(59)); /* following unrolled from: * for (i = 60; i < 80; i++) { * t = f2(b, c, d) + K4 + rol32(a, 5) + e + M(i); * e = d; d = c; c = rol32(b, 30); b = a; a = t; * } */ R(a, b, c, d, e, f4, K4, M(60)); R(e, a, b, c, d, f4, K4, M(61)); R(d, e, a, b, c, f4, K4, M(62)); R(c, d, e, a, b, f4, K4, M(63)); R(b, c, d, e, a, f4, K4, M(64)); R(a, b, c, d, e, f4, K4, M(65)); R(e, a, b, c, d, f4, K4, M(66)); R(d, e, a, b, c, f4, K4, M(67)); R(c, d, e, a, b, f4, K4, M(68)); R(b, c, d, e, a, f4, K4, M(69)); R(a, b, c, d, e, f4, K4, M(70)); R(e, a, b, c, d, f4, K4, M(71)); R(d, e, a, b, c, f4, K4, M(72)); R(c, d, e, a, b, f4, K4, M(73)); R(b, c, d, e, a, f4, K4, M(74)); R(a, b, c, d, e, f4, K4, M(75)); R(e, a, b, c, d, f4, K4, M(76)); R(d, e, a, b, c, f4, K4, M(77)); R(c, d, e, a, b, f4, K4, M(78)); R(b, c, d, e, a, f4, K4, M(79)); h[0] += a; h[1] += b; h[2] += c; h[3] += d; h[4] += e; } /** * sha1_update - Update the SHA1 context values with length bytes of data */ void sha1_update(struct sha1_ctx *ctx, unsigned char *data, int len) { unsigned int index, to_fill; index = (unsigned int) (ctx->sz & 0x3f); to_fill = 64 - index; ctx->sz += len; /* process partial buffer if there's enough data to make a block */ if (index && len >= to_fill) { memcpy(ctx->buf + index, data, to_fill); sha1_do_chunk(ctx->buf, ctx->h); len -= to_fill; data += to_fill; index = 0; } /* process as much 64-block as possible */ for (; len >= 64; len -= 64, data += 64) sha1_do_chunk(data, ctx->h); /* append data into buf */ if (len) memcpy(ctx->buf + index, data, len); } /** * sha1_finalize - Finalize the context and create the SHA1 digest */ void sha1_finalize(struct sha1_ctx *ctx, sha1_digest *out) { static unsigned char padding[64] = { 0x80, }; unsigned int bits[2]; unsigned int index, padlen; /* add padding and update data with it */ bits[0] = cpu_to_be32((unsigned int) (ctx->sz >> 29)); bits[1] = cpu_to_be32((unsigned int) (ctx->sz << 3)); /* pad out to 56 */ index = (unsigned int) (ctx->sz & 0x3f); padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); sha1_update(ctx, padding, padlen); /* append length */ sha1_update(ctx, (unsigned char *) bits, sizeof(bits)); /* output hash */ out->digest[0] = cpu_to_be32(ctx->h[0]); out->digest[1] = cpu_to_be32(ctx->h[1]); out->digest[2] = cpu_to_be32(ctx->h[2]); out->digest[3] = cpu_to_be32(ctx->h[3]); out->digest[4] = cpu_to_be32(ctx->h[4]); } /** * sha1_to_bin - Transform the SHA1 digest into a binary data */ void sha1_to_bin(sha1_digest *digest, char *out) { uint32_t *ptr = (uint32_t *) out; ptr[0] = digest->digest[0]; ptr[1] = digest->digest[1]; ptr[2] = digest->digest[2]; ptr[3] = digest->digest[3]; ptr[4] = digest->digest[4]; } /** * sha1_to_hex - Transform the SHA1 digest into a readable data */ void sha1_to_hex(sha1_digest *digest, char *out) { #define D(i) (cpu_to_be32(digest->digest[i])) snprintf(out, 41, "%08x%08x%08x%08x%08x", D(0), D(1), D(2), D(3), D(4)); #undef D } ocaml-sha-ocaml-sha-v1.9/sha1.h000066400000000000000000000021151222443151000162550ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1 implementation as describe in wikipedia. */ #ifndef SHA1_H #define SHA1_H struct sha1_ctx { unsigned int h[5]; unsigned char buf[64]; unsigned long long sz; }; typedef struct { unsigned int digest[5]; } sha1_digest; void sha1_init(struct sha1_ctx *ctx); void sha1_copy(struct sha1_ctx *dst, struct sha1_ctx *src); void sha1_update(struct sha1_ctx *ctx, unsigned char *data, int len); void sha1_finalize(struct sha1_ctx *ctx, sha1_digest *out); void sha1_to_bin(sha1_digest *digest, char *out); void sha1_to_hex(sha1_digest *digest, char *out); #endif ocaml-sha-ocaml-sha-v1.9/sha1.ml000066400000000000000000000046321222443151000164440ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1 OCaml binding *) type ctx type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t type t external init: unit -> ctx = "stub_sha1_init" external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha1_update" external update_buffer: ctx -> buf -> unit = "stub_sha1_update_bigarray" external finalize: ctx -> t = "stub_sha1_finalize" external copy : ctx -> ctx = "stub_sha1_copy" external to_bin: t -> string = "stub_sha1_to_bin" external to_hex: t -> string = "stub_sha1_to_hex" external file_fast: string -> t = "stub_sha1_file" let blksize = 4096 let update_substring ctx s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; unsafe_update_substring ctx s ofs len let update_string ctx s = unsafe_update_substring ctx s 0 (String.length s) let string s = let ctx = init () in unsafe_update_substring ctx s 0 (String.length s); finalize ctx let zero = string "" let substring s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; let ctx = init () in unsafe_update_substring ctx s ofs len; finalize ctx let buffer buf = let ctx = init () in update_buffer ctx buf; finalize ctx let channel chan len = let ctx = init () and buf = String.create blksize in let left = ref len and eof = ref false in while (!left == -1 || !left > 0) && not !eof do let len = if !left < 0 then blksize else (min !left blksize) in let readed = Pervasives.input chan buf 0 len in if readed = 0 then eof := true else ( unsafe_update_substring ctx buf 0 readed; if !left <> -1 then left := !left - readed ) done; if !left > 0 && !eof then raise End_of_file; finalize ctx let file name = let chan = open_in_bin name in let digest = channel chan (-1) in close_in chan; digest let input chan = channel chan (-1) let output chan digest = output_string chan (to_hex digest) ocaml-sha-ocaml-sha-v1.9/sha1.mli000066400000000000000000000056351222443151000166210ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * *) (** SHA1 OCaml binding *) (** context type - opaque *) type ctx (** buffer type *) type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** digest type - opaque *) type t (** The zero digest *) val zero : t (** Create a new context *) external init: unit -> ctx = "stub_sha1_init" (** Sha1.unsafe_update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. Unsafe: No range checking! *) external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha1_update" (** Sha1.update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. *) val update_substring: ctx -> string -> int -> int -> unit (** Sha1.update_string ctx s updates the context with s. *) val update_string: ctx -> string -> unit (** Sha1.update_buffer ctx a updates the context with a. Runs parallel to other threads if any exist. *) external update_buffer: ctx -> buf -> unit = "stub_sha1_update_bigarray" (** Finalize the context and return digest *) external finalize: ctx -> t = "stub_sha1_finalize" (** Return an copy of the context *) external copy : ctx -> ctx = "stub_sha1_copy" (** Return the digest of the given string. *) val string : string -> t (** Sha1.substring s ofs len returns the digest of the substring of s starting at character number ofs and containing len characters. *) val substring : string -> int -> int -> t (** If len is nonnegative, Sha1.channel ic len reads len characters from channel ic and returns their digest, or raises End_of_file if end-of-file is reached before len characters are read. If len is negative, Sha1.channel ic len reads all characters from ic until end-of-file is reached and return their digest. *) val channel : in_channel -> int -> t (** Return the digest of the file whose name is given. *) val file : string -> t (** Return the digest of the file whose name is given using fast C function *) val file_fast : string -> t (** Write a digest on the given output channel. *) val output : out_channel -> t -> unit (** Read a digest from the given input channel. *) val input : in_channel -> t (** return a binary representation of the given digest *) val to_bin : t -> string (** return a printable hexadecimal representation of the given digest *) val to_hex : t -> string ocaml-sha-ocaml-sha-v1.9/sha1_stubs.c000066400000000000000000000067101222443151000174750ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1 implementation as describe in wikipedia. */ #define _GNU_SOURCE #include #include #include "sha1.h" static inline int sha1_file(char *filename, sha1_digest *digest) { #define BLKSIZE 4096 unsigned char buf[BLKSIZE]; int fd; ssize_t n; struct sha1_ctx ctx; fd = open(filename, O_RDONLY | O_CLOEXEC); if (fd == -1) return 1; sha1_init(&ctx); while ((n = read(fd, buf, BLKSIZE)) > 0) sha1_update(&ctx, buf, n); if (n == 0) sha1_finalize(&ctx, digest); close(fd); return n < 0; #undef BLKSIZE } /* this part implement the OCaml binding */ #include #include #include #include #include #include #include #define GET_CTX_STRUCT(a) ((struct sha1_ctx *) a) CAMLexport value stub_sha1_init(value unit) { CAMLparam1(unit); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha1_ctx), Abstract_tag); sha1_init(GET_CTX_STRUCT(result)); CAMLreturn(result); } CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value len) { CAMLparam4(ctx, data, ofs, len); sha1_update(GET_CTX_STRUCT(ctx), (unsigned char *) data + Int_val(ofs), Int_val(len)); CAMLreturn(Val_unit); } CAMLprim value stub_sha1_update_bigarray(value ctx, value buf) { CAMLparam2(ctx, buf); unsigned char *data = Data_bigarray_val(buf); size_t len = Bigarray_val(buf)->dim[0]; caml_release_runtime_system(); sha1_update(GET_CTX_STRUCT(ctx), data, len); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value stub_sha1_finalize(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(sha1_digest), Abstract_tag); sha1_finalize(GET_CTX_STRUCT(ctx), (sha1_digest *) result); CAMLreturn(result); } CAMLprim value stub_sha1_copy(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha1_ctx), Abstract_tag); sha1_copy(GET_CTX_STRUCT(result), GET_CTX_STRUCT(ctx)); CAMLreturn(result); } #ifndef strdupa #define strdupa(s) strcpy(alloca(strlen(s)+1),s) #endif CAMLprim value stub_sha1_file(value name) { CAMLparam1(name); CAMLlocal1(result); char *name_dup = strdupa(String_val(name)); sha1_digest digest; caml_release_runtime_system(); if (sha1_file(name_dup, &digest)) { caml_acquire_runtime_system(); caml_failwith("file error"); } caml_acquire_runtime_system(); result = caml_alloc(sizeof(sha1_digest), Abstract_tag); memcpy((sha1_digest *)result, &digest, sizeof(sha1_digest)); CAMLreturn(result); } CAMLprim value stub_sha1_to_bin(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(20); sha1_to_bin((sha1_digest *) digest, String_val(result)); CAMLreturn(result); } CAMLprim value stub_sha1_to_hex(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(40); sha1_to_hex((sha1_digest *) digest, String_val(result)); CAMLreturn(result); } ocaml-sha-ocaml-sha-v1.9/sha256.c000066400000000000000000000131311222443151000164240ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA256 implementation */ #include #include #include "bitfn.h" #include "sha256.h" /** * sha256_init - Init SHA256 context */ void sha256_init(struct sha256_ctx *ctx) { memset(ctx, 0, sizeof(*ctx)); ctx->h[0] = 0x6a09e667; ctx->h[1] = 0xbb67ae85; ctx->h[2] = 0x3c6ef372; ctx->h[3] = 0xa54ff53a; ctx->h[4] = 0x510e527f; ctx->h[5] = 0x9b05688c; ctx->h[6] = 0x1f83d9ab; ctx->h[7] = 0x5be0cd19; } /** * sha256_copy - Copy SHA256 context */ void sha256_copy(struct sha256_ctx *dst, struct sha256_ctx *src) { memcpy(dst, src, sizeof(*dst)); } /* 232 times the cube root of the first 64 primes 2..311 */ static const unsigned int k[] = { 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 }; static inline unsigned int Ch(unsigned int x, unsigned int y, unsigned int z) { return z ^ (x & (y ^ z)); } static inline unsigned int Maj(unsigned int x, unsigned int y, unsigned int z) { return (x & y) | (z & (x | y)); } #define e0(x) (ror32(x, 2) ^ ror32(x,13) ^ ror32(x,22)) #define e1(x) (ror32(x, 6) ^ ror32(x,11) ^ ror32(x,25)) #define s0(x) (ror32(x, 7) ^ ror32(x,18) ^ (x >> 3)) #define s1(x) (ror32(x,17) ^ ror32(x,19) ^ (x >> 10)) /** * sha256_do_chunk - Process a block through SHA256 */ static void sha256_do_chunk(unsigned char __W[], unsigned int H[]) { unsigned int a, b, c, d, e, f, g, h, t1, t2; unsigned int W[64]; int i; for (i = 0; i < 16; i++) W[i] = be32_to_cpu(((unsigned int *) __W)[i]); for (i = 16; i < 64; i++) W[i] = s1(W[i - 2]) + W[i - 7] + s0(W[i - 15]) + W[i - 16]; a = H[0]; b = H[1]; c = H[2]; d = H[3]; e = H[4]; f = H[5]; g = H[6]; h = H[7]; #define T(a, b, c, d, e, f, g, h, k, w) \ do { \ t1 = h + e1(e) + Ch(e, f, g) + k + w; \ t2 = e0(a) + Maj(a, b, c); \ d += t1; \ h = t1 + t2; \ } while (0) #define PASS(i) \ do { \ T(a, b, c, d, e, f, g, h, k[i + 0], W[i + 0]); \ T(h, a, b, c, d, e, f, g, k[i + 1], W[i + 1]); \ T(g, h, a, b, c, d, e, f, k[i + 2], W[i + 2]); \ T(f, g, h, a, b, c, d, e, k[i + 3], W[i + 3]); \ T(e, f, g, h, a, b, c, d, k[i + 4], W[i + 4]); \ T(d, e, f, g, h, a, b, c, k[i + 5], W[i + 5]); \ T(c, d, e, f, g, h, a, b, k[i + 6], W[i + 6]); \ T(b, c, d, e, f, g, h, a, k[i + 7], W[i + 7]); \ } while (0) PASS(0); PASS(8); PASS(16); PASS(24); PASS(32); PASS(40); PASS(48); PASS(56); #undef T #undef PASS H[0] += a; H[1] += b; H[2] += c; H[3] += d; H[4] += e; H[5] += f; H[6] += g; H[7] += h; } /** * sha256_update - Update the SHA256 context values with length bytes of data */ void sha256_update(struct sha256_ctx *ctx, unsigned char *data, int len) { unsigned int index, to_fill; /* check for partial buffer */ index = (unsigned int) (ctx->sz & 0x3f); to_fill = 64 - index; ctx->sz += len; /* process partial buffer if there's enough data to make a block */ if (index && len >= to_fill) { memcpy(ctx->buf + index, data, to_fill); sha256_do_chunk(ctx->buf, ctx->h); len -= to_fill; data += to_fill; index = 0; } /* process as much 64-block as possible */ for (; len >= 64; len -= 64, data += 64) sha256_do_chunk(data, ctx->h); /* append data into buf */ if (len) memcpy(ctx->buf + index, data, len); } /** * sha256_finalize - Finalize the context and create the SHA256 digest */ void sha256_finalize(struct sha256_ctx *ctx, sha256_digest *out) { static unsigned char padding[64] = { 0x80, }; unsigned int bits[2]; unsigned int i, index, padlen; /* cpu -> big endian */ bits[0] = cpu_to_be32((unsigned int) (ctx->sz >> 29)); bits[1] = cpu_to_be32((unsigned int) (ctx->sz << 3)); /* pad out to 56 */ index = (unsigned int) (ctx->sz & 0x3f); padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); sha256_update(ctx, padding, padlen); /* append length */ sha256_update(ctx, (unsigned char *) bits, sizeof(bits)); /* store to digest */ for (i = 0; i < 8; i++) out->digest[i] = cpu_to_be32(ctx->h[i]); } /** * sha256_to_bin - Transform the SHA256 digest into a binary data */ void sha256_to_bin(sha256_digest *digest, char *out) { uint32_t *ptr = (uint32_t *) out; int i; for (i = 0; i < 8; i++) ptr[i] = digest->digest[i]; } /** * sha256_to_hex - Transform the SHA256 digest into a readable data */ void sha256_to_hex(sha256_digest *digest, char *out) { char *p; int i; for (p = out, i = 0; i < 8; i++, p += 8) snprintf(p, 9, "%08x", be32_to_cpu(digest->digest[i])); } ocaml-sha-ocaml-sha-v1.9/sha256.h000066400000000000000000000021311222443151000164270ustar00rootroot00000000000000/* Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA256 implementation */ #ifndef SHA256_H #define SHA256_H struct sha256_ctx { unsigned int h[8]; unsigned char buf[128]; unsigned long long sz; }; typedef struct { unsigned int digest[8]; } sha256_digest; void sha256_init(struct sha256_ctx *ctx); void sha256_copy(struct sha256_ctx *dst, struct sha256_ctx *src); void sha256_update(struct sha256_ctx *ctx, unsigned char *data, int len); void sha256_finalize(struct sha256_ctx *ctx, sha256_digest *out); void sha256_to_bin(sha256_digest *digest, char *out); void sha256_to_hex(sha256_digest *digest, char *out); #endif ocaml-sha-ocaml-sha-v1.9/sha256.ml000066400000000000000000000050751222443151000166220ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA256 OCaml binding *) type ctx type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t type t external init: unit -> ctx = "stub_sha256_init" external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha256_update" external update_buffer: ctx -> buf -> unit = "stub_sha256_update_bigarray" external finalize: ctx -> t = "stub_sha256_finalize" external copy : ctx -> ctx = "stub_sha256_copy" external to_bin: t -> string = "stub_sha256_to_bin" external to_hex: t -> string = "stub_sha256_to_hex" external file_fast: string -> t = "stub_sha256_file" let blksize = 4096 let update_substring ctx s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; unsafe_update_substring ctx s ofs len let update_string ctx s = unsafe_update_substring ctx s 0 (String.length s) external update_bigarray: ctx -> (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> unit = "stub_sha256_update_bigarray" let string s = let ctx = init () in unsafe_update_substring ctx s 0 (String.length s); finalize ctx let zero = string "" let substring s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; let ctx = init () in unsafe_update_substring ctx s ofs len; finalize ctx let buffer buf = let ctx = init () in update_buffer ctx buf; finalize ctx let channel chan len = let ctx = init () and buf = String.create blksize in let left = ref len and eof = ref false in while (!left == -1 || !left > 0) && not !eof do let len = if !left < 0 then blksize else (min !left blksize) in let readed = Pervasives.input chan buf 0 len in if readed = 0 then eof := true else ( unsafe_update_substring ctx buf 0 readed; if !left <> -1 then left := !left - readed ) done; if !left > 0 && !eof then raise End_of_file; finalize ctx let file name = let chan = open_in_bin name in let digest = channel chan (-1) in close_in chan; digest let input chan = channel chan (-1) let output chan digest = output_string chan (to_hex digest) ocaml-sha-ocaml-sha-v1.9/sha256.mli000066400000000000000000000057741222443151000170010ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * *) (** SHA256 OCaml binding *) (** context type - opaque *) type ctx (** buffer type *) type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** digest type - opaque *) type t (** The zero digest *) val zero : t (** Create a new context *) external init: unit -> ctx = "stub_sha256_init" (** Sha256.unsafe_update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. Unsafe: No range checking! *) external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha256_update" (** Sha256.update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. *) val update_substring: ctx -> string -> int -> int -> unit (** Sha256.update_string ctx s updates the context with s. *) val update_string: ctx -> string -> unit (** Sha256.update_buffer ctx a updates the context with a. Runs parallel to other threads if any exist. *) external update_buffer: ctx -> buf -> unit = "stub_sha256_update_bigarray" (** Finalize the context and return digest *) external finalize: ctx -> t = "stub_sha256_finalize" (** Return an copy of the context *) external copy : ctx -> ctx = "stub_sha256_copy" (** Return the digest of the given string. *) val string : string -> t (** Sha256.substring s ofs len returns the digest of the substring of s starting at character number ofs and containing len characters. *) val substring : string -> int -> int -> t (** Return the digest of the given buffer. *) val buffer : buf -> t (** If len is nonnegative, Sha256.channel ic len reads len characters from channel ic and returns their digest, or raises End_of_file if end-of-file is reached before len characters are read. If len is negative, Sha256.channel ic len reads all characters from ic until end-of-file is reached and return their digest. *) val channel : in_channel -> int -> t (** Return the digest of the file whose name is given. *) val file : string -> t (** Return the digest of the file whose name is given using fast C function *) val file_fast : string -> t (** Write a digest on the given output channel. *) val output : out_channel -> t -> unit (** Read a digest from the given input channel. *) val input : in_channel -> t (** return a binary representation of the given digest *) val to_bin : t -> string (** return a printable hexadecimal representation of the given digest *) val to_hex : t -> string ocaml-sha-ocaml-sha-v1.9/sha256_stubs.c000066400000000000000000000070111222443151000176440ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA256 implementation */ #define _GNU_SOURCE #include #include #include "sha256.h" static inline int sha256_file(char *filename, sha256_digest *digest) { #define BLKSIZE 4096 unsigned char buf[BLKSIZE]; int fd; ssize_t n; struct sha256_ctx ctx; fd = open(filename, O_RDONLY | O_CLOEXEC); if (fd == -1) return 1; sha256_init(&ctx); while ((n = read(fd, buf, BLKSIZE)) > 0) sha256_update(&ctx, buf, n); if (n == 0) sha256_finalize(&ctx, digest); close(fd); return n < 0; #undef BLKSIZE } /* this part implement the OCaml binding */ #include #include #include #include #include #include #include #define GET_CTX_STRUCT(a) ((struct sha256_ctx *) a) CAMLexport value stub_sha256_init(value unit) { CAMLparam1(unit); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha256_ctx), Abstract_tag); sha256_init(GET_CTX_STRUCT(result)); CAMLreturn(result); } CAMLprim value stub_sha256_update(value ctx, value data, value ofs, value len) { CAMLparam4(ctx, data, ofs, len); sha256_update(GET_CTX_STRUCT(ctx), (unsigned char *) data + Int_val(ofs), Int_val(len)); CAMLreturn(Val_unit); } CAMLprim value stub_sha256_update_bigarray(value ctx, value buf) { CAMLparam2(ctx, buf); unsigned char *data = Data_bigarray_val(buf); size_t len = Bigarray_val(buf)->dim[0]; caml_release_runtime_system(); sha256_update(GET_CTX_STRUCT(ctx), data, len); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value stub_sha256_finalize(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(sha256_digest), Abstract_tag); sha256_finalize(GET_CTX_STRUCT(ctx), (sha256_digest *) result); CAMLreturn(result); } CAMLprim value stub_sha256_copy(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha256_ctx), Abstract_tag); sha256_copy(GET_CTX_STRUCT(result), GET_CTX_STRUCT(ctx)); CAMLreturn(result); } #ifndef strdupa #define strdupa(s) strcpy(alloca(strlen(s)+1),s) #endif CAMLprim value stub_sha256_file(value name) { CAMLparam1(name); CAMLlocal1(result); char *name_dup = strdupa(String_val(name)); sha256_digest digest; caml_release_runtime_system(); if (sha256_file(name_dup, &digest)) { caml_acquire_runtime_system(); caml_failwith("file error"); } caml_acquire_runtime_system(); result = caml_alloc(sizeof(sha256_digest), Abstract_tag); memcpy((sha256_digest *)result, &digest, sizeof(sha256_digest)); CAMLreturn(result); } CAMLprim value stub_sha256_to_bin(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(32); sha256_to_bin((sha256_digest *) digest, String_val(result)); CAMLreturn(result); } CAMLprim value stub_sha256_to_hex(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(64); sha256_to_hex((sha256_digest *) digest, String_val(result)); CAMLreturn(result); } ocaml-sha-ocaml-sha-v1.9/sha512.c000066400000000000000000000154601222443151000164260ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA512 implementation */ #include #include #include "bitfn.h" #include "sha512.h" /** * sha512_init - Init SHA512 context */ void sha512_init(struct sha512_ctx *ctx) { memset(ctx, 0, sizeof(*ctx)); ctx->h[0] = 0x6a09e667f3bcc908ULL; ctx->h[1] = 0xbb67ae8584caa73bULL; ctx->h[2] = 0x3c6ef372fe94f82bULL; ctx->h[3] = 0xa54ff53a5f1d36f1ULL; ctx->h[4] = 0x510e527fade682d1ULL; ctx->h[5] = 0x9b05688c2b3e6c1fULL; ctx->h[6] = 0x1f83d9abfb41bd6bULL; ctx->h[7] = 0x5be0cd19137e2179ULL; } /** * sha512_copy - Copy SHA512 context */ void sha512_copy(struct sha512_ctx *dst, struct sha512_ctx *src) { memcpy(dst, src, sizeof(*dst)); } /* 232 times the cube root of the first 64 primes 2..311 */ static const uint64_t k[] = { 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL, }; static inline uint64_t Ch(uint64_t x, uint64_t y, uint64_t z) { return z ^ (x & (y ^ z)); } static inline uint64_t Maj(uint64_t x, uint64_t y, uint64_t z) { return (x & y) | (z & (x | y)); } #define e0(x) (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39)) #define e1(x) (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41)) #define s0(x) (ror64(x, 1) ^ ror64(x, 8) ^ (x >> 7)) #define s1(x) (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6)) /** * sha512_do_chunk - Process a block through SHA512 */ static void sha512_do_chunk(unsigned char __W[], uint64_t H[]) { uint64_t a, b, c, d, e, f, g, h, t1, t2; uint64_t W[80]; int i; for (i = 0; i < 16; i++) W[i] = be64_to_cpu(((uint64_t *) __W)[i]); for (i = 16; i < 80; i++) W[i] = s1(W[i - 2]) + W[i - 7] + s0(W[i - 15]) + W[i - 16]; a = H[0]; b = H[1]; c = H[2]; d = H[3]; e = H[4]; f = H[5]; g = H[6]; h = H[7]; #define T(a, b, c, d, e, f, g, h, k, w) \ do { \ t1 = h + e1(e) + Ch(e, f, g) + k + w; \ t2 = e0(a) + Maj(a, b, c); \ d += t1; \ h = t1 + t2; \ } while (0) #define PASS(i) \ do { \ T(a, b, c, d, e, f, g, h, k[i + 0], W[i + 0]); \ T(h, a, b, c, d, e, f, g, k[i + 1], W[i + 1]); \ T(g, h, a, b, c, d, e, f, k[i + 2], W[i + 2]); \ T(f, g, h, a, b, c, d, e, k[i + 3], W[i + 3]); \ T(e, f, g, h, a, b, c, d, k[i + 4], W[i + 4]); \ T(d, e, f, g, h, a, b, c, k[i + 5], W[i + 5]); \ T(c, d, e, f, g, h, a, b, k[i + 6], W[i + 6]); \ T(b, c, d, e, f, g, h, a, k[i + 7], W[i + 7]); \ } while (0) PASS(0); PASS(8); PASS(16); PASS(24); PASS(32); PASS(40); PASS(48); PASS(56); PASS(64); PASS(72); #undef T #undef PASS H[0] += a; H[1] += b; H[2] += c; H[3] += d; H[4] += e; H[5] += f; H[6] += g; H[7] += h; } /** * sha512_update - Update the SHA512 context values with length bytes of data */ void sha512_update(struct sha512_ctx *ctx, unsigned char *data, int len) { unsigned int index, to_fill; /* check for partial buffer */ index = (unsigned int) (ctx->sz[0] & 0x7f); to_fill = 128 - index; ctx->sz[0] += len; if (ctx->sz[0] < len) ctx->sz[1]++; /* process partial buffer if there's enough data to make a block */ if (index && len >= to_fill) { memcpy(ctx->buf + index, data, to_fill); sha512_do_chunk(ctx->buf, ctx->h); len -= to_fill; data += to_fill; index = 0; } /* process as much 128-block as possible */ for (; len >= 128; len -= 128, data += 128) sha512_do_chunk(data, ctx->h); /* append data into buf */ if (len) memcpy(ctx->buf + index, data, len); } /** * sha512_finalize - Finalize the context and create the SHA512 digest */ void sha512_finalize(struct sha512_ctx *ctx, sha512_digest *out) { static unsigned char padding[128] = { 0x80, }; unsigned int i, index, padlen; uint64_t bits[2]; /* cpu -> big endian */ bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61)); bits[1] = cpu_to_be64((ctx->sz[0] << 3)); /* pad out to 56 */ index = (unsigned int) (ctx->sz[0] & 0x7f); padlen = (index < 112) ? (112 - index) : ((128 + 112) - index); sha512_update(ctx, padding, padlen); /* append length */ sha512_update(ctx, (unsigned char *) bits, sizeof(bits)); /* store to digest */ for (i = 0; i < 8; i++) out->digest[i] = cpu_to_be64(ctx->h[i]); } /** * sha512_to_bin - Transform the SHA512 digest into a binary data */ void sha512_to_bin(sha512_digest *digest, char *out) { uint64_t *ptr = (uint64_t *) out; int i; for (i = 0; i < 8; i++) ptr[i] = digest->digest[i]; } /** * sha512_to_hex - Transform the SHA512 digest into a readable data */ void sha512_to_hex(sha512_digest *digest, char *out) { char *p; int i; for (p = out, i = 0; i < 8; i++, p += 16) snprintf(p, 17, "%016llx", (unsigned long long) be64_to_cpu(digest->digest[i])); } ocaml-sha-ocaml-sha-v1.9/sha512.h000066400000000000000000000021401222443151000164220ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA512 implementation */ #ifndef SHA512_H #define SHA512_H #include struct sha512_ctx { uint64_t h[8]; unsigned char buf[128]; uint64_t sz[2]; }; typedef struct { uint64_t digest[8]; } sha512_digest; void sha512_init(struct sha512_ctx *ctx); void sha512_copy(struct sha512_ctx *dst, struct sha512_ctx *src); void sha512_update(struct sha512_ctx *ctx, unsigned char *data, int len); void sha512_finalize(struct sha512_ctx *ctx, sha512_digest *out); void sha512_to_bin(sha512_digest *digest, char *out); void sha512_to_hex(sha512_digest *digest, char *out); #endif ocaml-sha-ocaml-sha-v1.9/sha512.ml000066400000000000000000000046531222443151000166160ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA512 OCaml binding *) type ctx type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t type t external init: unit -> ctx = "stub_sha512_init" external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha512_update" external update_buffer: ctx -> buf -> unit = "stub_sha512_update_bigarray" external finalize: ctx -> t = "stub_sha512_finalize" external copy : ctx -> ctx = "stub_sha512_copy" external to_bin: t -> string = "stub_sha512_to_bin" external to_hex: t -> string = "stub_sha512_to_hex" external file_fast: string -> t = "stub_sha512_file" let blksize = 4096 let update_substring ctx s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; unsafe_update_substring ctx s ofs len let update_string ctx s = unsafe_update_substring ctx s 0 (String.length s) let string s = let ctx = init () in unsafe_update_substring ctx s 0 (String.length s); finalize ctx let zero = string "" let substring s ofs len = if len <= 0 && String.length s < ofs + len then invalid_arg "substring"; let ctx = init () in unsafe_update_substring ctx s ofs len; finalize ctx let buffer buf = let ctx = init () in update_buffer ctx buf; finalize ctx let channel chan len = let ctx = init () and buf = String.create blksize in let left = ref len and eof = ref false in while (!left == -1 || !left > 0) && not !eof do let len = if !left < 0 then blksize else (min !left blksize) in let readed = Pervasives.input chan buf 0 len in if readed = 0 then eof := true else ( unsafe_update_substring ctx buf 0 readed; if !left <> -1 then left := !left - readed ) done; if !left > 0 && !eof then raise End_of_file; finalize ctx let file name = let chan = open_in_bin name in let digest = channel chan (-1) in close_in chan; digest let input chan = channel chan (-1) let output chan digest = output_string chan (to_hex digest) ocaml-sha-ocaml-sha-v1.9/sha512.mli000066400000000000000000000057741222443151000167740ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * *) (** SHA512 OCaml binding *) (** context type - opaque *) type ctx (** buffer type *) type buf = (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** digest type - opaque *) type t (** The zero digest *) val zero : t (** Create a new context *) external init: unit -> ctx = "stub_sha512_init" (** Sha512.unsafe_update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. Unsafe: No range checking! *) external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_sha512_update" (** Sha512.update_substring ctx s ofs len updates the context with the substring of s starting at character number ofs and containing len characters. *) val update_substring: ctx -> string -> int -> int -> unit (** Sha512.update_string ctx s updates the context with s. *) val update_string: ctx -> string -> unit (** Sha512.update_buffer ctx a updates the context with a. Runs parallel to other threads if any exist. *) external update_buffer: ctx -> buf -> unit = "stub_sha512_update_bigarray" (** Finalize the context and return digest *) external finalize: ctx -> t = "stub_sha512_finalize" (** Return an copy of the context *) external copy : ctx -> ctx = "stub_sha512_copy" (** Return the digest of the given string. *) val string : string -> t (** Sha512.substring s ofs len returns the digest of the substring of s starting at character number ofs and containing len characters. *) val substring : string -> int -> int -> t (** Return the digest of the given buffer. *) val buffer : buf -> t (** If len is nonnegative, Sha512.channel ic len reads len characters from channel ic and returns their digest, or raises End_of_file if end-of-file is reached before len characters are read. If len is negative, Sha512.channel ic len reads all characters from ic until end-of-file is reached and return their digest. *) val channel : in_channel -> int -> t (** Return the digest of the file whose name is given. *) val file : string -> t (** Return the digest of the file whose name is given using fast C function *) val file_fast : string -> t (** Write a digest on the given output channel. *) val output : out_channel -> t -> unit (** Read a digest from the given input channel. *) val input : in_channel -> t (** return a binary representation of the given digest *) val to_bin : t -> string (** return a printable hexadecimal representation of the given digest *) val to_hex : t -> string ocaml-sha-ocaml-sha-v1.9/sha512_stubs.c000066400000000000000000000070121222443151000176400ustar00rootroot00000000000000/* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA512 implementation */ #define _GNU_SOURCE #include #include #include "sha512.h" static inline int sha512_file(char *filename, sha512_digest *digest) { #define BLKSIZE 4096 unsigned char buf[BLKSIZE]; int fd; ssize_t n; struct sha512_ctx ctx; fd = open(filename, O_RDONLY | O_CLOEXEC); if (fd == -1) return 1; sha512_init(&ctx); while ((n = read(fd, buf, BLKSIZE)) > 0) sha512_update(&ctx, buf, n); if (n == 0) sha512_finalize(&ctx, digest); close(fd); return n < 0; #undef BLKSIZE } /* this part implement the OCaml binding */ #include #include #include #include #include #include #include #define GET_CTX_STRUCT(a) ((struct sha512_ctx *) a) CAMLexport value stub_sha512_init(value unit) { CAMLparam1(unit); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha512_ctx), Abstract_tag); sha512_init(GET_CTX_STRUCT(result)); CAMLreturn(result); } CAMLprim value stub_sha512_update(value ctx, value data, value ofs, value len) { CAMLparam4(ctx, data, ofs, len); sha512_update(GET_CTX_STRUCT(ctx), (unsigned char *) data + Int_val(ofs), Int_val(len)); CAMLreturn(Val_unit); } CAMLprim value stub_sha512_update_bigarray(value ctx, value buf) { CAMLparam2(ctx, buf); unsigned char *data = Data_bigarray_val(buf); size_t len = Bigarray_val(buf)->dim[0]; caml_release_runtime_system(); sha512_update(GET_CTX_STRUCT(ctx), data, len); caml_acquire_runtime_system(); CAMLreturn(Val_unit); } CAMLprim value stub_sha512_finalize(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(sha512_digest), Abstract_tag); sha512_finalize(GET_CTX_STRUCT(ctx), (sha512_digest *) result); CAMLreturn(result); } CAMLprim value stub_sha512_copy(value ctx) { CAMLparam1(ctx); CAMLlocal1(result); result = caml_alloc(sizeof(struct sha512_ctx), Abstract_tag); sha512_copy(GET_CTX_STRUCT(result), GET_CTX_STRUCT(ctx)); CAMLreturn(result); } #ifndef strdupa #define strdupa(s) strcpy(alloca(strlen(s)+1),s) #endif CAMLprim value stub_sha512_file(value name) { CAMLparam1(name); CAMLlocal1(result); char *name_dup = strdupa(String_val(name)); sha512_digest digest; caml_release_runtime_system(); if (sha512_file(name_dup, &digest)) { caml_acquire_runtime_system(); caml_failwith("file error"); } caml_acquire_runtime_system(); result = caml_alloc(sizeof(sha512_digest), Abstract_tag); memcpy((sha512_digest *)result, &digest, sizeof(sha512_digest)); CAMLreturn(result); } CAMLprim value stub_sha512_to_bin(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(64); sha512_to_bin((sha512_digest *) digest, String_val(result)); CAMLreturn(result); } CAMLprim value stub_sha512_to_hex(value digest) { CAMLparam1(digest); CAMLlocal1(result); result = caml_alloc_string(128); sha512_to_hex((sha512_digest *) digest, String_val(result)); CAMLreturn(result); } ocaml-sha-ocaml-sha-v1.9/shasum.ml000066400000000000000000000051121222443151000171020ustar00rootroot00000000000000(* * Copyright (C) 2006-2009 Vincent Hanquez * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 or version 3.0 only. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * SHA1sum - test ocaml SHA1 binding *) open Printf let printfct get_digest file = let digest = get_digest file in printf "%s %s\n" digest file let checkfct get_digest file = let chan = open_in file in let nb = ref 0 and failed = ref 0 in begin try while true do let line = input_line chan in Scanf.sscanf line "%s %s" (fun hex file -> let digest = get_digest file in let fail = digest <> hex in if fail then incr failed; incr nb; printf "%s: %s\n" file (if fail then "FAILED" else "OK") ) done with End_of_file -> () end; if !failed > 0 then eprintf "sha1sum: WARNING: %d of %d computed checksums did NOT match\n" !failed !nb; close_in chan (* main fct *) let _ = let files = ref [] in let eoa = ref false and check = ref false in (* parse arg *) for i = 1 to Array.length Sys.argv - 1 do let opt = Sys.argv.(i) in if !eoa then files := opt :: !files else match opt with | "--check" | "-c" -> check := true | "--binary" | "-b" -> () | "--text" | "-t" -> () | "--" -> eoa := true | "" -> () | s -> if s.[0] = '-' then eprintf "unknown option: %s" s else files := opt :: !files done; let md5 file = Digest.to_hex (Digest.file file) in let sha1 file = Sha1.to_hex (Sha1.file file) in let sha256 file = Sha256.to_hex (Sha256.file file) in let sha512 file = Sha512.to_hex (Sha512.file file) in let basename = Filename.basename Sys.argv.(0) in let prog = if Sys.os_type = "Win32" then try Filename.chop_extension basename with Invalid_argument _ -> basename else basename in let sha = match prog with | "sha512sum" -> sha512 | "sha256sum" -> sha256 | "sha1sum" -> sha1 | "md5sum" -> md5 | _ -> sha1 in let execfct_with_catch file = try (if !check then checkfct else printfct) sha file with exn -> eprintf "error: %s: %s\n" file (Printexc.to_string exn) in (* apply function on every file *) List.iter (fun file -> execfct_with_catch file) (List.rev !files)