This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions

View file

@ -0,0 +1,99 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA implementation low level operation
*/
#ifndef BITFN_H
#define BITFN_H
#include <stdint.h>
// NOTE: Required to build on OpenBSD
#undef swap32
#undef swap64
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 <architecture/byte_order.h>
#elif defined(__FreeBSD__)
#include <sys/endian.h>
#elif _WIN32
/* nothing */
#else
#include <endian.h>
#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 */

View file

@ -0,0 +1,7 @@
let flags =
match Sys.win32 with
| true -> "()"
| false -> "(-Wall -O3 -funroll-loops)"
let () =
print_endline flags

View file

@ -0,0 +1,16 @@
(rule
(with-stdout-to
c_flags.sexp
(run %{ocaml} %{dep:c_flags.ml})))
(library
(name sha)
(synopsis "SHA-1 and SHA-2 family implementations")
(wrapped false)
(modules sha1 sha256 sha512)
(foreign_stubs
(language c)
(flags
:standard
(:include c_flags.sexp))
(names sha1_stubs sha256_stubs sha512_stubs)))

View file

@ -0,0 +1,310 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA1 implementation as describe in wikipedia.
*/
#ifndef SHA1_H
#define SHA1_H
#include <string.h>
#include <stdio.h>
#include "bitfn.h"
#include "util.h"
struct sha1_ctx
{
unsigned int h[5];
unsigned char buf[64];
unsigned long long sz;
};
typedef struct { unsigned int digest[5]; } sha1_digest;
/**
* sha1_init - Init SHA1 context
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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
}
/**
* sha1_of_bin - Transform binary data into the SHA1 digest
*/
static void sha1_of_bin(const char *in, sha1_digest *digest)
{
memcpy(digest->digest, in, sizeof(*digest));
}
/**
* sha1_of_hex - Transform readable data into the SHA1 digest
*/
static void sha1_of_hex(const char *in, sha1_digest *digest)
{
if (strlen(in) != 40)
return;
of_hex((unsigned char *) digest->digest, in, 40);
}
#endif

View file

@ -0,0 +1,93 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA1 OCaml binding
*)
type ctx
type buf = (char, 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 of_bin: bytes -> t = "stub_sha1_of_bin"
external of_hex: string -> t = "stub_sha1_of_hex"
external file_fast: string -> t = "stub_sha1_file"
external equal: t -> t -> bool = "stub_sha1_equal"
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 channel chan len =
let ctx = init ()
and buf = Bytes.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 = Stdlib.input chan buf 0 len in
if readed = 0 then
eof := true
else (
let buf = Bytes.unsafe_to_string buf in
unsafe_update_substring ctx buf 0 readed;
(* [unsafe_update_substring] does not hold on to [buf],
so we can mutate it again now *)
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)

View file

@ -0,0 +1,103 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** SHA1 OCaml binding *)
(** Context type - opaque. *)
type ctx
(** Buffer type. *)
type buf = (char, 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 a 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
(** Returns whether two hashes are equal. *)
val equal : t -> t -> bool
(** Sha1.of_bin digest converts the binary representation of a digest to the
internal representation of Sha1.t. *)
val of_bin : bytes -> t
(** Sha1.of_hex digest converts the hexadecimal representation of a digest to
the internal representation of Sha1.t. *)
val of_hex : string -> t

View file

@ -0,0 +1,205 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA1 implementation as describe in wikipedia.
*/
#define _GNU_SOURCE
#ifdef _MSC_VER
#include <BaseTsd.h>
typedef SSIZE_T ssize_t;
#define alloca _alloca
#else
#include <unistd.h>
#endif
#include <string.h>
#include <fcntl.h>
#include <string.h>
#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;
#ifndef O_CLOEXEC
fd = open(filename, O_RDONLY);
#else
fd = open(filename, O_RDONLY | O_CLOEXEC);
#endif
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 <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/bigarray.h>
#include <caml/threads.h>
#include <caml/version.h>
#if OCAML_VERSION < 40600
#define Bytes_val(x) ((unsigned char *) Bp_val(x))
#endif
#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);
struct sha1_ctx ctx_dup;
unsigned char *data = Caml_ba_data_val(buf);
size_t len = Caml_ba_array_val(buf)->dim[0];
ctx_dup = *GET_CTX_STRUCT(ctx);
caml_release_runtime_system();
sha1_update(&ctx_dup, data, len);
caml_acquire_runtime_system();
*GET_CTX_STRUCT(ctx) = ctx_dup;
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, &Byte(result, 0));
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, &Byte(result, 0));
CAMLreturn(result);
}
CAMLprim value stub_sha1_equal(value t1, value t2)
{
CAMLparam2(t1, t2);
int b = memcmp((sha1_digest *) t1, (sha1_digest *) t2, sizeof(sha1_digest)) == 0;
CAMLreturn(Val_bool(b));
}
CAMLprim value stub_sha1_of_bin(value bin)
{
CAMLparam1(bin);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha1_digest), Abstract_tag);
sha1_of_bin((const char *) Bytes_val(bin), (sha1_digest *) result);
CAMLreturn(result);
}
CAMLprim value stub_sha1_of_hex(value hex)
{
CAMLparam1(hex);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha1_digest), Abstract_tag);
sha1_of_hex(String_val(hex), (sha1_digest *) result);
CAMLreturn(result);
}

View file

@ -0,0 +1,255 @@
/*
Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA256 implementation
*/
#ifndef SHA256_H
#define SHA256_H
#include <string.h>
#include <stdio.h>
#include "bitfn.h"
#include "util.h"
struct sha256_ctx
{
unsigned int h[8];
unsigned char buf[128];
unsigned long long sz;
};
typedef struct { unsigned int digest[8]; } sha256_digest;
/**
* sha256_init - Init SHA256 context
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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]));
}
/**
* sha256_of_bin - Transform binary data into the SHA256 digest
*/
static void sha256_of_bin(const char *in, sha256_digest *digest)
{
memcpy(digest->digest, in, sizeof(*digest));
}
/**
* sha256_of_hex - Transform readable data into the SHA256 digest
*/
static void sha256_of_hex(const char *in, sha256_digest *digest)
{
if (strlen(in) != 64)
return;
of_hex((unsigned char *) digest->digest, in, 64);
}
#endif

View file

@ -0,0 +1,97 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* 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 of_bin: bytes -> t = "stub_sha256_of_bin"
external of_hex: string -> t = "stub_sha256_of_hex"
external file_fast: string -> t = "stub_sha256_file"
external equal: t -> t -> bool = "stub_sha256_equal"
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 = Bytes.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 = Stdlib.input chan buf 0 len in
if readed = 0 then
eof := true
else (
let buf = Bytes.unsafe_to_string buf in
unsafe_update_substring ctx buf 0 readed;
(* [unsafe_update_substring] does not hold on to [buf],
so we can mutate it again now *)
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)

View file

@ -0,0 +1,102 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** 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 a 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
(** Returns whether two hashes are equal. *)
val equal : t -> t -> bool
(** Sha256.of_bin digest converts the binary representation of a digest to the
internal representation of Sha256.t. *)
val of_bin : bytes -> t
(** Sha256.of_hex digest converts the hexadecimal representation of a digest to
the internal representation of Sha256.t. *)
val of_hex : string -> t

View file

@ -0,0 +1,203 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA256 implementation
*/
#define _GNU_SOURCE
#ifdef _MSC_VER
#include <BaseTsd.h>
typedef SSIZE_T ssize_t;
#define alloca _alloca
#else
#include <unistd.h>
#endif
#include <string.h>
#include <fcntl.h>
#include <string.h>
#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;
#ifndef O_CLOEXEC
fd = open(filename, O_RDONLY);
#else
fd = open(filename, O_RDONLY | O_CLOEXEC);
#endif
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 <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/bigarray.h>
#include <caml/threads.h>
#include <caml/version.h>
#if OCAML_VERSION < 40600
#define Bytes_val(x) ((unsigned char *) Bp_val(x))
#endif
#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);
struct sha256_ctx ctx_dup;
unsigned char *data = Caml_ba_data_val(buf);
size_t len = Caml_ba_array_val(buf)->dim[0];
ctx_dup = *GET_CTX_STRUCT(ctx);
caml_release_runtime_system();
sha256_update(&ctx_dup, data, len);
caml_acquire_runtime_system();
*GET_CTX_STRUCT(ctx) = ctx_dup;
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, &Byte(result, 0));
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, &Byte(result, 0));
CAMLreturn(result);
}
CAMLprim value stub_sha256_equal(value t1, value t2)
{
CAMLparam2(t1, t2);
int b = memcmp((sha256_digest *) t1, (sha256_digest *) t2, sizeof(sha256_digest)) == 0;
CAMLreturn(Val_bool(b));
}
CAMLprim value stub_sha256_of_bin(value bin)
{
CAMLparam1(bin);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha256_digest), Abstract_tag);
sha256_of_bin((const char *) Bytes_val(bin), (sha256_digest *) result);
CAMLreturn(result);
}
CAMLprim value stub_sha256_of_hex(value hex)
{
CAMLparam1(hex);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha256_digest), Abstract_tag);
sha256_of_hex(String_val(hex), (sha256_digest *) result);
CAMLreturn(result);
}

View file

@ -0,0 +1,279 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA512 implementation
*/
#ifndef SHA512_H
#define SHA512_H
#include <stdint.h>
#include <string.h>
#include <stdio.h>
#include "bitfn.h"
#include "util.h"
struct sha512_ctx
{
uint64_t h[8];
unsigned char buf[128];
uint64_t sz[2];
};
typedef struct { uint64_t digest[8]; } sha512_digest;
/**
* sha512_init - Init SHA512 context
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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
*/
static 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]));
}
/**
* sha512_of_bin - Transform binary data into the SHA512 digest
*/
static void sha512_of_bin(const char *in, sha512_digest *digest)
{
memcpy(digest->digest, in, sizeof(*digest));
}
/**
* sha512_of_hex - Transform readable data into the SHA512 digest
*/
static void sha512_of_hex(const char *in, sha512_digest *digest)
{
if (strlen(in) != 128)
return;
of_hex((unsigned char *) digest->digest, in, 128);
}
#endif

View file

@ -0,0 +1,97 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* 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 of_bin: bytes -> t = "stub_sha256_of_bin"
external of_hex: string -> t = "stub_sha256_of_hex"
external file_fast: string -> t = "stub_sha512_file"
external equal: t -> t -> bool = "stub_sha512_equal"
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 = Bytes.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 = Stdlib.input chan buf 0 len in
if readed = 0 then
eof := true
else (
let buf = Bytes.unsafe_to_string buf in
unsafe_update_substring ctx buf 0 readed;
(* [unsafe_update_substring] does not hold on to [buf],
so we can mutate it again now *)
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)

View file

@ -0,0 +1,102 @@
(*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** 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 a 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
(** Returns whether two hashes are equal. *)
val equal : t -> t -> bool
(** Sha512.of_bin digest converts the binary representation of a digest to the
internal representation of Sha512.t. *)
val of_bin : bytes -> t
(** Sha512.of_hex digest converts the hexadecimal representation of a digest to
the internal representation of Sha512.t. *)
val of_hex : string -> t

View file

@ -0,0 +1,203 @@
/*
* Copyright (C) 2006-2009 Vincent Hanquez <tab@snarc.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
* SHA512 implementation
*/
#define _GNU_SOURCE
#ifdef _MSC_VER
#include <BaseTsd.h>
typedef SSIZE_T ssize_t;
#define alloca _alloca
#else
#include <unistd.h>
#endif
#include <string.h>
#include <fcntl.h>
#include <string.h>
#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;
#ifndef O_CLOEXEC
fd = open(filename, O_RDONLY);
#else
fd = open(filename, O_RDONLY | O_CLOEXEC);
#endif
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 <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/bigarray.h>
#include <caml/threads.h>
#include <caml/version.h>
#if OCAML_VERSION < 40600
#define Bytes_val(x) ((unsigned char *) Bp_val(x))
#endif
#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);
struct sha512_ctx ctx_dup;
unsigned char *data = Caml_ba_data_val(buf);
size_t len = Caml_ba_array_val(buf)->dim[0];
ctx_dup = *GET_CTX_STRUCT(ctx);
caml_release_runtime_system();
sha512_update(&ctx_dup, data, len);
caml_acquire_runtime_system();
*GET_CTX_STRUCT(ctx) = ctx_dup;
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, &Byte(result, 0));
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, &Byte(result, 0));
CAMLreturn(result);
}
CAMLprim value stub_sha512_equal(value t1, value t2)
{
CAMLparam2(t1, t2);
int b = memcmp((sha512_digest *) t1, (sha512_digest *) t2, sizeof(sha512_digest)) == 0;
CAMLreturn(Val_bool(b));
}
CAMLprim value stub_sha512_of_bin(value bin)
{
CAMLparam1(bin);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha512_digest), Abstract_tag);
sha512_of_bin((const char *) Bytes_val(bin), (sha512_digest *) result);
CAMLreturn(result);
}
CAMLprim value stub_sha512_of_hex(value hex)
{
CAMLparam1(hex);
CAMLlocal1(result);
result = caml_alloc(sizeof(sha512_digest), Abstract_tag);
sha512_of_hex(String_val(hex), (sha512_digest *) result);
CAMLreturn(result);
}

View file

@ -0,0 +1,35 @@
#ifndef UTIL_H
#define UTIL_H
static int hex_to_int(char c)
{
if ('0' <= c && c <= '9')
return c - '0';
else if ('a' <= c && c <= 'f')
return c - 'a' + 10;
else if ('A' <= c && c <= 'F')
return c - 'A' + 10;
else
return -1;
}
static int of_hex(unsigned char *dst, const char *src, int n)
{
int i;
if (n % 2 != 0)
return -1;
for (i = 0; i < n/2; i++) {
int a, b;
a = hex_to_int(src[i*2]);
if(a < 0)
return -1;
b = hex_to_int(src[i*2 + 1]);
if(b < 0)
return -1;
dst[i] = a*16 + b;
}
return n/2;
}
#endif