Add md5 digest

Author: Christopher Zimmermann

jbuild

@@ -5,6 +5,6 @@
   (public_name sha)
   (synopsis "SHA-1 and SHA-2 family implementations")
   (wrapped false)
-  (modules (hash sha1 sha256 sha512))
+  (modules (hash md5 sha1 sha256 sha512))
   (c_flags (-Wall -O3 -funroll-loops)) ; Needs adapting for Windows
-  (c_names (sha1c sha1_stubs sha256c sha256_stubs sha512c sha512_stubs))))
+  (c_names (md5_stubs sha1c sha1_stubs sha256c sha256_stubs sha512c sha512_stubs))))

md5.h

@@ -0,0 +1,42 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
+/*                                                                        */
+/*   Copyright 1999 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* MD5 message digest */
+
+#include <caml/config.h>
+
+#ifndef CAML_MD5_H
+#define CAML_MD5_H
+
+
+CAMLextern value caml_md5_string (value str, value ofs, value len);
+CAMLextern value caml_md5_chan (value vchan, value len);
+CAMLextern void caml_md5_block(unsigned char digest[16],
+                               void * data, uintnat len);
+
+struct MD5Context {
+        uint32_t buf[4];
+        uint32_t bits[2];
+        unsigned char in[64];
+};
+
+CAMLextern void caml_MD5Init (struct MD5Context *context);
+CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf,
+                                uintnat len);
+CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
+CAMLextern void caml_MD5Transform (uint32_t *buf, uint32_t *in);
+
+
+#endif /* CAML_MD5_H */

md5.ml

@@ -0,0 +1,11 @@
+include Hash.Make (struct
+    type ctx
+    type t = string
+    let digest_length = 128
+
+    external to_bin: t -> string = "%identity"
+    external init: unit -> ctx = "stub_md5_init"
+    external unsafe_update_substring: ctx -> string -> int -> int -> unit = "stub_md5_update"
+    external update_buffer: ctx -> Hash.buf -> unit = "stub_md5_update_bigarray"
+    external finalize: ctx -> t = "stub_md5_finalize"
+  end)

md5.mli

@@ -0,0 +1,88 @@
+(*
+ *	Copyright (C) 2006-2009 Vincent Hanquez <[email protected]>
+ *
+ * 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.
+ *
+ *)
+
+(** MD5 OCaml binding *)
+
+(** context type - opaque *)
+type ctx
+
+(** digest type - opaque *)
+type t
+
+(** The zero digest *)
+val zero : t
+
+(** Create a new context *)
+val init: unit -> ctx
+
+(** Md5.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! *)
+val unsafe_update_substring: ctx -> string -> int -> int -> unit
+
+(** Md5.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
+
+(** Md5.update_string ctx s updates the context with s. *)
+val update_string: ctx -> string -> unit
+
+(** Md5.update_buffer ctx a updates the context with a.
+    Runs parallel to other threads if any exist. *)
+val update_buffer: ctx -> Hash.buf -> unit
+
+(** Finalize the context and return digest *)
+val finalize: ctx -> t
+
+(** Return an copy of the context *)
+val copy : ctx -> ctx
+
+(** Return the digest of the given string. *)
+val string : string -> t
+
+(** Md5.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 : Hash.buf -> t
+
+(** If len is nonnegative, Md5.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, Md5.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

md5_stubs.c

@@ -0,0 +1,74 @@
+/*
+ *	Copyright (c) 2017 Christopher Zimmermann <[email protected]>
+ *
+ * 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.
+ *
+ *
+ * md5 stub code linking to the md5 backend in the OCaml runtime.
+ */
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/bigarray.h>
+#include <caml/threads.h>
+
+#include "md5.h"
+
+#define GET_CTX_STRUCT(a) ((struct MD5Context *) a)
+
+CAMLprim value stub_md5_init(value unit)
+{
+	value ctx;
+
+	ctx = caml_alloc_small(sizeof(struct MD5Context), Abstract_tag);
+	caml_MD5Init(GET_CTX_STRUCT(ctx));
+
+	return(ctx);
+}
+
+CAMLprim value stub_md5_update(value ctx, value data, value ofs, value len)
+{
+	caml_MD5Update(GET_CTX_STRUCT(ctx),
+		(unsigned char *) data + Int_val(ofs), Int_val(len));
+
+	return(Val_unit);
+}
+
+CAMLprim value stub_md5_update_bigarray(value ctx, value buf)
+{
+	CAMLparam2(ctx, buf);
+	struct MD5Context ctx_dup = *GET_CTX_STRUCT(ctx);
+	unsigned char *data = Data_bigarray_val(buf);
+	size_t len = Bigarray_val(buf)->dim[0];
+
+	caml_release_runtime_system();
+	caml_MD5Update(&ctx_dup, data, len);
+	caml_acquire_runtime_system();
+
+	*GET_CTX_STRUCT(ctx) = ctx_dup;
+	CAMLreturn(Val_unit);
+}
+
+CAMLprim value stub_md5_finalize(value ctx)
+{
+	CAMLparam1(ctx);
+	value result;
+
+	result = caml_alloc_string(16);
+	caml_MD5Final(
+		(unsigned char *)Bp_val(result),
+		GET_CTX_STRUCT(ctx));
+
+	CAMLreturn(result);
+}

test/shatest.ml

@@ -21,6 +21,15 @@ open OUnit
 let cog = "The quick brown fox jumps over the lazy cog"
 let dog = "The quick brown fox jumps over the lazy dog"
 
+let ex_strings_md5 = [
+	("",
+	"d41d8cd98f00b204e9800998ecf8427e");
+	("The quick brown fox jumps over the lazy cog",
+	"1055d3e698d289f2af8663725127bd4b");
+	("The quick brown fox jumps over the lazy dog",
+	"9e107d9d372bb6826bd81d3542a419d6");
+]
+
 let ex_strings_sha1 = [
 	("",
 	"da39a3ee5e6b4b0d3255bfef95601890afd80709");
@@ -46,6 +55,10 @@ let ex_strings_sha512 = [
 	"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6"); ]
 
 
+let ex_files_md5 =
+	[ ("sample.txt",
+	"9e107d9d372bb6826bd81d3542a419d6") ]
+
 let ex_files_sha1 =
 	[ ("sample.txt",
 	"2fd4e1c67a2d28fced849ee1bb76e7391b93eb12") ]
@@ -58,6 +71,10 @@ let ex_files_sha512 =
 	[ ("sample.txt",
 	"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6") ]
 
+
+let ex_channels_md5 =
+	[ ("sample.txt", "9e107d9d372bb6826bd81d3542a419d6") ]
+
 let ex_channels_sha1 =
 	[ ("sample.txt", "2fd4e1c67a2d28fced849ee1bb76e7391b93eb12") ]
 
@@ -69,14 +86,17 @@ let ex_channels_sha512 =
 	[ ("sample.txt",
 	"07e547d9586f6a73f73fbac0435ed76951218fb7d0c8d788a309d785436bbb642e93a252a954f23912547d1e8a3b5ed6e1bfd7097821233fa0538f3db854fee6") ]
 
+let stringfct_md5 s = Md5.to_hex (Md5.string s)
 let stringfct_sha1 s = Sha1.to_hex (Sha1.string s)
 let stringfct_sha256 s = Sha256.to_hex (Sha256.string s)
 let stringfct_sha512 s = Sha512.to_hex (Sha512.string s)
 
+let filefct_md5 s = Md5.to_hex (Md5.file s)
 let filefct_sha1 s = Sha1.to_hex (Sha1.file s)
 let filefct_sha256 s = Sha256.to_hex (Sha256.file s)
 let filefct_sha512 s = Sha512.to_hex (Sha512.file s)
 
+let channelfct_md5 s i = Md5.to_hex (Md5.channel s i)
 let channelfct_sha1 s i = Sha1.to_hex (Sha1.channel s i)
 let channelfct_sha256 s i = Sha256.to_hex (Sha256.channel s i)
 let channelfct_sha512 s i = Sha512.to_hex (Sha512.channel s i)
@@ -94,8 +114,14 @@ let test_channel channelfct arr _ =
 		close_in chan;
 		assert_equal r digest) arr
 
-let suite = "SHA binding test" >:::
-	[ "SHA1 example strings" >::
+let suite = "hash bindings test" >:::
+	[ "MD5 example strings" >::
+		test_strings stringfct_md5 ex_strings_md5;
+	  "MD5 reading a file" >::
+		test_file filefct_md5 ex_files_md5;
+	  "MD5 reading few byte from channel" >::
+		test_channel channelfct_md5 ex_channels_md5;
+          "SHA1 example strings" >::
 		test_strings stringfct_sha1 ex_strings_sha1;
 	  "SHA1 reading a file" >::
 		test_file filefct_sha1 ex_files_sha1;