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 <e...@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits