C implementation of sha3.

src-c/digestif.ml

@@ -569,6 +569,17 @@ module SHA512 : S with type kind = [ `SHA512 ] =
       let kind = `SHA512
     end)
 
+module SHA3 : S with type kind = [ `SHA3 ] =
+  Make
+    (Native.SHA3)
+    (struct
+      let digest_size, block_size = (64, 71)
+
+      type kind = [ `SHA3 ]
+
+      let kind = `SHA3
+    end)
+
 module WHIRLPOOL : S with type kind = [ `WHIRLPOOL ] =
   Make
     (Native.WHIRLPOOL)
@@ -667,6 +678,7 @@ let module_of : type k. k hash -> (module S with type kind = k) =
   | SHA256 -> (module SHA256)
   | SHA384 -> (module SHA384)
   | SHA512 -> (module SHA512)
+  | SHA3 -> (module SHA3)
   | WHIRLPOOL -> (module WHIRLPOOL)
   | BLAKE2B digest_size -> (
       match Hashtbl.find b2b digest_size with
@@ -823,6 +835,8 @@ let of_sha384 hash = of_raw_string sha384 (SHA384.to_raw_string hash)
 
 let of_sha512 hash = of_raw_string sha512 (SHA512.to_raw_string hash)
 
+let of_sha3 hash = of_raw_string sha3 (SHA3.to_raw_string hash)
+
 let of_whirlpool hash = of_raw_string whirlpool (WHIRLPOOL.to_raw_string hash)
 
 let of_blake2b hash =

src-c/digestif_native.ml

@@ -201,6 +201,35 @@ module SHA512 = struct
   external ctx_size : unit -> int = "caml_digestif_sha512_ctx_size" [@@noalloc]
 end
 
+module SHA3 = struct
+  type kind = [ `SHA3 ]
+
+  module Bigstring = struct
+    external init : ctx -> unit = "caml_digestif_sha3_ba_init" [@@noalloc]
+
+    external update : ctx -> ba -> off -> size -> unit
+      = "caml_digestif_sha3_ba_update"
+
+    external finalize : ctx -> ba -> off -> unit
+      = "caml_digestif_sha3_ba_finalize"
+      [@@noalloc]
+  end
+
+  module Bytes = struct
+    external init : ctx -> unit = "caml_digestif_sha3_st_init" [@@noalloc]
+
+    external update : ctx -> st -> off -> size -> unit
+      = "caml_digestif_sha3_st_update"
+      [@@noalloc]
+
+    external finalize : ctx -> st -> off -> unit
+      = "caml_digestif_sha3_st_finalize"
+      [@@noalloc]
+  end
+
+  external ctx_size : unit -> int = "caml_digestif_sha3_ctx_size" [@@noalloc]
+end
+
 module WHIRLPOOL = struct
   type kind = [ `WHIRLPOOL ]
 

src-c/native/dune

@@ -3,7 +3,7 @@
  (public_name digestif.rakia)
  (foreign_stubs
   (language c)
-  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 whirlpool misc
+  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 sha3 whirlpool misc
     stubs)
   (flags
    (:standard -I.))))

src-c/native/freestanding/dune

@@ -5,7 +5,7 @@
  (libraries bigarray-compat ocaml-freestanding)
  (foreign_stubs
   (language c)
-  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 whirlpool misc
+  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 sha3 whirlpool misc
     stubs)
   (flags
    (:include cflags.sexp))))
@@ -31,6 +31,9 @@
 (rule
  (copy# ../sha512.c sha512.c))
 
+(rule
+ (copy# ../sha3.c sha3.c))
+
 (rule
  (copy# ../whirlpool.c whirlpool.c))
 

src-c/native/sha3.c

@@ -0,0 +1,159 @@
+/*  Copyright (c) 2015 Markku-Juhani O. Saarinen */
+
+#include "sha3.h"
+
+#ifndef KECCAKF_ROUNDS
+#define KECCAKF_ROUNDS 24
+#endif
+
+#ifndef ROTL64
+#define ROTL64(x, y) (((x) << (y)) | ((x) >> (64 - (y))))
+#endif
+
+// update the state with given number of rounds
+
+void sha3_keccakf(uint64_t st[25])
+{
+    // constants
+    const uint64_t keccakf_rndc[24] = {
+        0x0000000000000001, 0x0000000000008082, 0x800000000000808a,
+        0x8000000080008000, 0x000000000000808b, 0x0000000080000001,
+        0x8000000080008081, 0x8000000000008009, 0x000000000000008a,
+        0x0000000000000088, 0x0000000080008009, 0x000000008000000a,
+        0x000000008000808b, 0x800000000000008b, 0x8000000000008089,
+        0x8000000000008003, 0x8000000000008002, 0x8000000000000080,
+        0x000000000000800a, 0x800000008000000a, 0x8000000080008081,
+        0x8000000000008080, 0x0000000080000001, 0x8000000080008008
+    };
+    const int keccakf_rotc[24] = {
+        1,  3,  6,  10, 15, 21, 28, 36, 45, 55, 2,  14,
+        27, 41, 56, 8,  25, 43, 62, 18, 39, 61, 20, 44
+    };
+    const int keccakf_piln[24] = {
+        10, 7,  11, 17, 18, 3, 5,  16, 8,  21, 24, 4,
+        15, 23, 19, 13, 12, 2, 20, 14, 22, 9,  6,  1
+    };
+
+    // variables
+    int i, j, r;
+    uint64_t t, bc[5];
+
+#if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__
+    uint8_t *v;
+
+    // endianess conversion. this is redundant on little-endian targets
+    for (i = 0; i < 25; i++) {
+        v = (uint8_t *) &st[i];
+        st[i] = ((uint64_t) v[0])     | (((uint64_t) v[1]) << 8) |
+            (((uint64_t) v[2]) << 16) | (((uint64_t) v[3]) << 24) |
+            (((uint64_t) v[4]) << 32) | (((uint64_t) v[5]) << 40) |
+            (((uint64_t) v[6]) << 48) | (((uint64_t) v[7]) << 56);
+    }
+#endif
+
+    // actual iteration
+    for (r = 0; r < KECCAKF_ROUNDS; r++) {
+
+        // Theta
+        for (i = 0; i < 5; i++)
+            bc[i] = st[i] ^ st[i + 5] ^ st[i + 10] ^ st[i + 15] ^ st[i + 20];
+
+        for (i = 0; i < 5; i++) {
+            t = bc[(i + 4) % 5] ^ ROTL64(bc[(i + 1) % 5], 1);
+            for (j = 0; j < 25; j += 5)
+                st[j + i] ^= t;
+        }
+
+        // Rho Pi
+        t = st[1];
+        for (i = 0; i < 24; i++) {
+            j = keccakf_piln[i];
+            bc[0] = st[j];
+            st[j] = ROTL64(t, keccakf_rotc[i]);
+            t = bc[0];
+        }
+
+        //  Chi
+        for (j = 0; j < 25; j += 5) {
+            for (i = 0; i < 5; i++)
+                bc[i] = st[j + i];
+            for (i = 0; i < 5; i++)
+	      st[j + i] ^= (~bc[(i + 1) % 5]) & bc[(i + 2) % 5];
+        }
+
+        //  Iota
+        st[0] ^= keccakf_rndc[r];
+    }
+
+#if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__
+    // endianess conversion. this is redundant on little-endian targets
+    for (i = 0; i < 25; i++) {
+        v = (uint8_t *) &st[i];
+        t = st[i];
+        v[0] = t & 0xFF;
+        v[1] = (t >> 8) & 0xFF;
+        v[2] = (t >> 16) & 0xFF;
+        v[3] = (t >> 24) & 0xFF;
+        v[4] = (t >> 32) & 0xFF;
+        v[5] = (t >> 40) & 0xFF;
+        v[6] = (t >> 48) & 0xFF;
+        v[7] = (t >> 56) & 0xFF;
+    }
+#endif
+}
+
+// Initialize the context for SHA3
+
+void digestif_sha3_init(struct sha3_ctx *ctx/*, int mdlen*/)
+{
+    int i;
+    /*to change*/
+    int mdlen = 64;
+    for (i = 0; i < 25; i++)
+        ctx->st.q[i] = 0;
+    ctx->mdlen = mdlen;
+    ctx->rsiz = 200 - 2 * mdlen;
+    ctx->pt = 0;
+
+    return;
+}
+
+// update state with more data
+
+void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len)
+{
+    uint32_t i;
+    int j;
+
+    j = ctx->pt;
+    for (i = 0; i < len; i++) {
+        ctx->st.b[j++] ^= data[i];
+        if (j >= ctx->rsiz) {
+            sha3_keccakf(ctx->st.q);
+            j = 0;
+        }
+    }
+    ctx->pt = j;
+
+    return;
+}
+
+// finalize and output a hash
+
+void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *md)
+{
+    int i;
+
+    //padding
+    ctx->st.b[ctx->pt] ^= 0x06;
+    ctx->st.b[ctx->rsiz - 1] ^= 0x80;
+
+    //call f on the last block
+    sha3_keccakf(ctx->st.q);
+
+    for (i = 0; i < ctx->mdlen; i++) {
+        md[i] = ctx->st.b[i];
+    }
+
+    return;
+}

src-c/native/sha3.h

@@ -0,0 +1,26 @@
+/*  Copyright (c) 2015 Markku-Juhani O. Saarinen */
+
+#ifndef CRYPTOHASH_SHA3_H
+#define CRYPTOHASH_SHA3_H
+
+#include <stdint.h>
+
+
+struct sha3_ctx
+{
+  union {                                 // state:
+    uint8_t  b[200];                      // 8-bit bytes
+    uint64_t q[25];                       // 64-bit words
+  } st;
+  int pt, rsiz, mdlen;                    // these don't overflow
+};
+
+
+#define SHA3_DIGEST_SIZE	64
+#define SHA3_CTX_SIZE		sizeof(struct sha3_ctx)
+
+void digestif_sha3_init(struct sha3_ctx *ctx);
+void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len);
+void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *out);
+
+#endif

src-c/native/stubs.c

@@ -4,6 +4,7 @@
 #include "sha1.h"
 #include "sha256.h"
 #include "sha512.h"
+#include "sha3.h"
 #include "whirlpool.h"
 #include "blake2b.h"
 #include "blake2s.h"
@@ -79,6 +80,7 @@ __define_hash (sha224, SHA224)
 __define_hash (sha256, SHA256)
 __define_hash (sha384, SHA384)
 __define_hash (sha512, SHA512)
+__define_hash (sha3, SHA3)
 __define_hash (whirlpool, WHIRLPOOL)
 __define_hash (blake2b, BLAKE2B)
 __define_hash (blake2s, BLAKE2S)

src-c/native/xen/dune

@@ -5,7 +5,7 @@
  (libraries bigarray-compat mirage-xen-posix)
  (foreign_stubs
   (language c)
-  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 whirlpool misc
+  (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 sha3 whirlpool misc
     stubs)
   (flags
    (:include cflags.sexp))))
@@ -31,6 +31,9 @@
 (rule
  (copy# ../sha512.c sha512.c))
 
+(rule
+ (copy# ../sha3.c sha3.c))
+
 (rule
  (copy# ../whirlpool.c whirlpool.c))
 

src/digestif.mli

@@ -206,6 +206,7 @@ type kind =
   | `SHA256
   | `SHA384
   | `SHA512
+  | `SHA3
   | `WHIRLPOOL
   | `BLAKE2B
   | `BLAKE2S ]
@@ -218,6 +219,7 @@ type 'k hash =
   | SHA256 : [ `SHA256 ] hash
   | SHA384 : [ `SHA384 ] hash
   | SHA512 : [ `SHA512 ] hash
+  | SHA3 : [ `SHA3 ] hash
   | WHIRLPOOL : [ `WHIRLPOOL ] hash
   | BLAKE2B : int -> [ `BLAKE2B ] hash
   | BLAKE2S : int -> [ `BLAKE2S ] hash
@@ -234,6 +236,8 @@ module SHA384 : S with type kind = [ `SHA384 ]
 
 module SHA512 : S with type kind = [ `SHA512 ]
 
+module SHA3 : S with type kind = [ `SHA3 ]
+
 module WHIRLPOOL : S with type kind = [ `WHIRLPOOL ]
 
 module BLAKE2B : sig
@@ -272,6 +276,8 @@ val sha384 : [ `SHA384 ] hash
 
 val sha512 : [ `SHA512 ] hash
 
+val sha3 : [ `SHA3 ] hash
+
 val whirlpool : [ `WHIRLPOOL ] hash
 
 val blake2b : int -> [ `BLAKE2B ] hash
@@ -339,6 +345,8 @@ val of_sha384 : SHA384.t -> [ `SHA384 ] t
 
 val of_sha512 : SHA512.t -> [ `SHA512 ] t
 
+val of_sha3 : SHA3.t -> [ `SHA3 ] t
+
 val of_whirlpool : WHIRLPOOL.t -> [ `WHIRLPOOL ] t
 
 val of_blake2b : BLAKE2B.t -> [ `BLAKE2B ] t

src/digestif_hash.ml

@@ -6,6 +6,7 @@ type 'kind hash =
   | SHA256 : [ `SHA256 ] hash
   | SHA384 : [ `SHA384 ] hash
   | SHA512 : [ `SHA512 ] hash
+  | SHA3 : [ `SHA3 ] hash
   | WHIRLPOOL : [ `WHIRLPOOL ] hash
   | BLAKE2B : int -> [ `BLAKE2B ] hash
   | BLAKE2S : int -> [ `BLAKE2S ] hash
@@ -18,6 +19,7 @@ and kind =
   | `SHA256
   | `SHA384
   | `SHA512
+  | `SHA3
   | `WHIRLPOOL
   | `BLAKE2B
   | `BLAKE2S ]
@@ -36,6 +38,8 @@ let sha384 = SHA384
 
 let sha512 = SHA512
 
+let sha3 = SHA3
+
 let whirlpool = WHIRLPOOL
 
 let blake2b length = BLAKE2B length