[Pkg-ocaml-maint-commits] [ocaml-sha] 01/09: Imported Upstream version 1.9
Eric Cooper
ecc at cmu.edu
Sat Nov 2 16:52:41 UTC 2013
This is an automated email from the git hooks/post-receive script.
ecc-guest pushed a commit to branch master
in repository ocaml-sha.
commit d0d62a6f62d6f320829315933d0ffde42e692da4
Author: Eric Cooper <ecc at cmu.edu>
Date: Fri Nov 1 20:03:31 2013 -0400
Imported Upstream version 1.9
---
.gitignore | 8 ++++++++
META | 8 ++++----
bitfn.h | 5 +++++
sha1.c | 21 ++++++++++++++-------
sha1.h | 1 +
sha1.ml | 27 +++++++++++++++++++++++----
sha1.mli | 35 +++++++++++++++++++++++++++++++++++
sha1_stubs.c | 46 +++++++++++++++++++++++++++++++++++++++++++---
sha256.c | 11 +++++++++--
sha256.h | 1 +
sha256.ml | 28 ++++++++++++++++++++++++----
sha256.mli | 38 ++++++++++++++++++++++++++++++++++++++
sha256_stubs.c | 45 ++++++++++++++++++++++++++++++++++++++++++---
sha512.c | 10 +++++++++-
sha512.h | 1 +
sha512.ml | 26 ++++++++++++++++++++++----
sha512.mli | 38 ++++++++++++++++++++++++++++++++++++++
sha512_stubs.c | 45 ++++++++++++++++++++++++++++++++++++++++++---
18 files changed, 359 insertions(+), 35 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..492d7ff
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,8 @@
+*.a
+*.o
+*.so
+*.cmi
+*.cmx
+*.cmxa
+*.cmo
+*.cma
diff --git a/META b/META
index 4f4c9e1..3dead25 100644
--- a/META
+++ b/META
@@ -1,25 +1,25 @@
description="SHA-1 and SHA-2 family implementations"
-version="1.7"
+version="1.9"
archive(byte)="sha.cma"
archive(native)="sha.cmxa"
package "sha1" (
description="SHA-1 Implementation"
- version="1.7"
+ version="1.9"
archive(byte)="sha1.cma"
archive(native)="sha1.cmxa"
)
package "sha256" (
description="SHA-256 Implementation"
- version="1.7"
+ version="1.9"
archive(byte)="sha256.cma"
archive(native)="sha256.cmxa"
)
package "sha512" (
description="SHA-512 Implementation"
- version="1.7"
+ version="1.9"
archive(byte)="sha512.cma"
archive(native)="sha512.cmxa"
)
diff --git a/bitfn.h b/bitfn.h
index 2edc72f..525043b 100644
--- a/bitfn.h
+++ b/bitfn.h
@@ -65,7 +65,12 @@ static inline uint64_t swap64(uint64_t a)
#endif
/* big endian to cpu */
+#ifdef __APPLE__
+#include <architecture/byte_order.h>
+#else
#include <endian.h>
+#endif
+
#if LITTLE_ENDIAN == BYTE_ORDER
#define be32_to_cpu(a) swap32(a)
#define cpu_to_be32(a) swap32(a)
diff --git a/sha1.c b/sha1.c
index 8d4d8fe..9302ef9 100644
--- a/sha1.c
+++ b/sha1.c
@@ -33,6 +33,14 @@ void sha1_init(struct sha1_ctx *ctx)
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 */
@@ -242,17 +250,17 @@ void sha1_finalize(struct sha1_ctx *ctx, sha1_digest *out)
}
/**
- * sha1_to_hex - Transform the SHA1 digest into a binary data
+ * 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] = cpu_to_be32(digest->digest[0]);
- ptr[1] = cpu_to_be32(digest->digest[1]);
- ptr[2] = cpu_to_be32(digest->digest[2]);
- ptr[3] = cpu_to_be32(digest->digest[3]);
- ptr[4] = cpu_to_be32(digest->digest[4]);
+ 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];
}
/**
@@ -266,4 +274,3 @@ void sha1_to_hex(sha1_digest *digest, char *out)
D(0), D(1), D(2), D(3), D(4));
#undef D
}
-
diff --git a/sha1.h b/sha1.h
index c0ca58d..95821c6 100644
--- a/sha1.h
+++ b/sha1.h
@@ -25,6 +25,7 @@ struct sha1_ctx
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);
diff --git a/sha1.ml b/sha1.ml
index f46e572..743196d 100644
--- a/sha1.ml
+++ b/sha1.ml
@@ -14,27 +14,46 @@
*)
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 update: ctx -> string -> int -> int -> unit = "stub_sha1_update"
+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
- update ctx s 0 (String.length s);
+ 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
- update ctx s ofs len;
+ 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 =
@@ -49,7 +68,7 @@ let channel chan len =
if readed = 0 then
eof := true
else (
- update ctx buf 0 readed;
+ unsafe_update_substring ctx buf 0 readed;
if !left <> -1 then left := !left - readed
)
done;
diff --git a/sha1.mli b/sha1.mli
index e87cf63..b5b560c 100644
--- a/sha1.mli
+++ b/sha1.mli
@@ -14,9 +14,44 @@
(** 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
diff --git a/sha1_stubs.c b/sha1_stubs.c
index 3770682..e0260bc 100644
--- a/sha1_stubs.c
+++ b/sha1_stubs.c
@@ -13,6 +13,7 @@
* SHA1 implementation as describe in wikipedia.
*/
+#define _GNU_SOURCE
#include <unistd.h>
#include <fcntl.h>
#include "sha1.h"
@@ -24,7 +25,7 @@ static inline int sha1_file(char *filename, sha1_digest *digest)
int fd; ssize_t n;
struct sha1_ctx ctx;
- fd = open(filename, O_RDONLY);
+ fd = open(filename, O_RDONLY | O_CLOEXEC);
if (fd == -1)
return 1;
sha1_init(&ctx);
@@ -43,6 +44,8 @@ static inline int sha1_file(char *filename, sha1_digest *digest)
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
+#include <caml/bigarray.h>
+#include <caml/threads.h>
#define GET_CTX_STRUCT(a) ((struct sha1_ctx *) a)
@@ -67,6 +70,20 @@ CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value 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);
@@ -78,14 +95,37 @@ CAMLprim value stub_sha1_finalize(value ctx)
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);
- if (sha1_file(String_val(name), (sha1_digest *) result))
- caml_failwith("file error");
+ memcpy((sha1_digest *)result, &digest, sizeof(sha1_digest));
CAMLreturn(result);
}
diff --git a/sha256.c b/sha256.c
index e5db569..c9dbc70 100644
--- a/sha256.c
+++ b/sha256.c
@@ -36,6 +36,14 @@ void sha256_init(struct sha256_ctx *ctx)
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,
@@ -197,7 +205,7 @@ void sha256_to_bin(sha256_digest *digest, char *out)
int i;
for (i = 0; i < 8; i++)
- ptr[i] = be32_to_cpu(digest->digest[i]);
+ ptr[i] = digest->digest[i];
}
/**
@@ -211,4 +219,3 @@ void sha256_to_hex(sha256_digest *digest, char *out)
for (p = out, i = 0; i < 8; i++, p += 8)
snprintf(p, 9, "%08x", be32_to_cpu(digest->digest[i]));
}
-
diff --git a/sha256.h b/sha256.h
index ee535b8..047ac28 100644
--- a/sha256.h
+++ b/sha256.h
@@ -25,6 +25,7 @@ struct sha256_ctx
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);
diff --git a/sha256.ml b/sha256.ml
index 87c514f..5ffd7e7 100644
--- a/sha256.ml
+++ b/sha256.ml
@@ -14,27 +14,47 @@
*)
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 update: ctx -> string -> int -> int -> unit = "stub_sha256_update"
+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
- update ctx s 0 (String.length s);
+ 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
- update ctx s ofs len;
+ 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 =
@@ -49,7 +69,7 @@ let channel chan len =
if readed = 0 then
eof := true
else (
- update ctx buf 0 readed;
+ unsafe_update_substring ctx buf 0 readed;
if !left <> -1 then left := !left - readed
)
done;
diff --git a/sha256.mli b/sha256.mli
index d6f669a..dfb921f 100644
--- a/sha256.mli
+++ b/sha256.mli
@@ -14,9 +14,44 @@
(** 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
@@ -24,6 +59,9 @@ val string : string -> t
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
diff --git a/sha256_stubs.c b/sha256_stubs.c
index 5a70e1b..303171d 100644
--- a/sha256_stubs.c
+++ b/sha256_stubs.c
@@ -13,6 +13,7 @@
* SHA256 implementation
*/
+#define _GNU_SOURCE
#include <unistd.h>
#include <fcntl.h>
#include "sha256.h"
@@ -24,7 +25,7 @@ static inline int sha256_file(char *filename, sha256_digest *digest)
int fd; ssize_t n;
struct sha256_ctx ctx;
- fd = open(filename, O_RDONLY);
+ fd = open(filename, O_RDONLY | O_CLOEXEC);
if (fd == -1)
return 1;
sha256_init(&ctx);
@@ -43,6 +44,8 @@ static inline int sha256_file(char *filename, sha256_digest *digest)
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
+#include <caml/bigarray.h>
+#include <caml/threads.h>
#define GET_CTX_STRUCT(a) ((struct sha256_ctx *) a)
@@ -66,6 +69,19 @@ CAMLprim value stub_sha256_update(value ctx, value data, value ofs, value 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);
@@ -77,14 +93,37 @@ CAMLprim value stub_sha256_finalize(value ctx)
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);
- if (sha256_file(String_val(name), (sha256_digest *) result))
- caml_failwith("file error");
+ memcpy((sha256_digest *)result, &digest, sizeof(sha256_digest));
CAMLreturn(result);
}
diff --git a/sha512.c b/sha512.c
index ca01d3d..490a75c 100644
--- a/sha512.c
+++ b/sha512.c
@@ -35,6 +35,14 @@ void sha512_init(struct sha512_ctx *ctx)
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,
@@ -217,7 +225,7 @@ void sha512_to_bin(sha512_digest *digest, char *out)
int i;
for (i = 0; i < 8; i++)
- ptr[i] = be64_to_cpu(digest->digest[i]);
+ ptr[i] = digest->digest[i];
}
diff --git a/sha512.h b/sha512.h
index 6ac311b..45e7bdd 100644
--- a/sha512.h
+++ b/sha512.h
@@ -27,6 +27,7 @@ struct sha512_ctx
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);
diff --git a/sha512.ml b/sha512.ml
index b38fb8c..6c5ce16 100644
--- a/sha512.ml
+++ b/sha512.ml
@@ -14,27 +14,45 @@
*)
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 update: ctx -> string -> int -> int -> unit = "stub_sha512_update"
+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
- update ctx s 0 (String.length s);
+ 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
- update ctx s ofs len;
+ 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 =
@@ -49,7 +67,7 @@ let channel chan len =
if readed = 0 then
eof := true
else (
- update ctx buf 0 readed;
+ unsafe_update_substring ctx buf 0 readed;
if !left <> -1 then left := !left - readed
)
done;
diff --git a/sha512.mli b/sha512.mli
index bc71dc8..99b565e 100644
--- a/sha512.mli
+++ b/sha512.mli
@@ -14,9 +14,44 @@
(** 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
@@ -24,6 +59,9 @@ val string : string -> t
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
diff --git a/sha512_stubs.c b/sha512_stubs.c
index 0b49357..2a7a071 100644
--- a/sha512_stubs.c
+++ b/sha512_stubs.c
@@ -13,6 +13,7 @@
* SHA512 implementation
*/
+#define _GNU_SOURCE
#include <unistd.h>
#include <fcntl.h>
#include "sha512.h"
@@ -24,7 +25,7 @@ static inline int sha512_file(char *filename, sha512_digest *digest)
int fd; ssize_t n;
struct sha512_ctx ctx;
- fd = open(filename, O_RDONLY);
+ fd = open(filename, O_RDONLY | O_CLOEXEC);
if (fd == -1)
return 1;
sha512_init(&ctx);
@@ -43,6 +44,8 @@ static inline int sha512_file(char *filename, sha512_digest *digest)
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
+#include <caml/bigarray.h>
+#include <caml/threads.h>
#define GET_CTX_STRUCT(a) ((struct sha512_ctx *) a)
@@ -66,6 +69,19 @@ CAMLprim value stub_sha512_update(value ctx, value data, value ofs, value 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);
@@ -77,14 +93,37 @@ CAMLprim value stub_sha512_finalize(value ctx)
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);
- if (sha512_file(String_val(name), (sha512_digest *) result))
- caml_failwith("file error");
+ memcpy((sha512_digest *)result, &digest, sizeof(sha512_digest));
CAMLreturn(result);
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-sha.git
More information about the Pkg-ocaml-maint-commits
mailing list